July 2018 - XEmacs-Patches - XEmacs Mailing List Archives

[COMMIT] Improve vector handling, backquote.el 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1531784981 -3600 # Tue Jul 17 00:49:41 2018 +0100 # Node ID e736ffdceecbe2b6a87040cd222fc8f6313bc575 # Parent dde704f40544aa0fe8eecbf2b92fbdbb7eeeb057 Improve vector handling, backquote.el lisp/ChangeLog addition: 2018-07-17 Aidan Kehoe <kehoea(a)parhasard.net> * backquote.el (bq-process-2): Be better about handling vectors here; pass through constants, call #'vector, #'vconcat directly at runtime if appropriate. Call #'atom (which translates to bytecode) rather than #'vectorp first within this function. New #'bq-process-2 flag, vector*, which means "call apply #'vector in the old way" * backquote.el (bq-comma): Don't check for numberp here, leave that to #'bq-process-1. * backquote.el (bq-process-1): Implement vector*. Call #'quote-maybe when appropriate, giving more readable output. diff -r dde704f40544 -r e736ffdceecb lisp/ChangeLog --- a/lisp/ChangeLog Wed Jul 11 03:06:18 2018 +0100 +++ b/lisp/ChangeLog Tue Jul 17 00:49:41 2018 +0100 ＠＠ -1,3 +1,18 ＠＠ +2018-07-17 Aidan Kehoe <kehoea(a)parhasard.net> + + * backquote.el (bq-process-2): + Be better about handling vectors here; pass through constants, + call #'vector, #'vconcat directly at runtime if appropriate. Call + #'atom (which translates to bytecode) rather than #'vectorp first + within this function. + New #'bq-process-2 flag, vector*, which means "call apply + #'vector in the old way" + * backquote.el (bq-comma): + Don't check for numberp here, leave that to #'bq-process-1. + * backquote.el (bq-process-1): + Implement vector*. Call #'quote-maybe when appropriate, giving + more readable output. + 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> Silence an extensive list of byte compile warnings, chiefly diff -r dde704f40544 -r e736ffdceecb lisp/backquote.el --- a/lisp/backquote.el Wed Jul 11 03:06:18 2018 +0100 +++ b/lisp/backquote.el Tue Jul 17 00:49:41 2018 +0100 ＠＠ -186,14 +186,26 ＠＠ ;;; This does the expansion from table 2. (defun bq-process-2 (code) - (cond ((vectorp code) - (let* ((dflag-d (bq-process-2 (append code nil)))) - (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d))))) - ((atom code) - (cond ((null code) (cons nil nil)) - ((or (numberp code) (eq code t)) - (cons t code)) - (t (cons 'quote code)))) + (cond ((atom code) + (cond ((null code) + (cons nil nil)) + ((vectorp code) + (let* ((dflag-d (bq-process-2 (append code nil))) + (dflag (car dflag-d)) + (d (cdr dflag-d))) + (cond + ((memq dflag '(quote nil)) + (cons t code)) + ((eq dflag 'list) + (cons 'vector d)) + ((eq dflag 'append) + ;; The idea for this is from GNU, thank you GNU. I don't + ;; like #'vconcat much, it's not very CL, but it does fit + ;; this use case, and there is no prospect of our + ;; removing it. + (cons 'vconcat d)) + (t (cons 'vector* (bq-process-1 dflag d)))))) + (t (cons 'quote code)))) ((eq (car code) bq-at-marker) (cons bq-at-flag (nth 1 code))) ((eq (car code) bq-dot-marker) ＠＠ -249,7 +261,7 ＠＠ (cond ((atom code) (cond ((null code) (cons nil nil)) - ((or (numberp code) (eq code 't)) + ((eq code t) (cons t code)) (t (cons bq-comma-flag code)))) ((eq (car code) 'quote) ＠＠ -262,13 +274,12 ＠＠ ;;; This handles table 1. (defun bq-process-1 (flag thing) - (cond ((or (eq flag bq-comma-flag) - (memq flag '(t nil))) + (cond ((eq flag bq-comma-flag) thing) - ((eq flag 'quote) - (list 'quote thing)) - ((eq flag 'vector) - (list 'apply '(function vector) thing)) + ((memq flag '(quote t nil)) + (quote-maybe thing)) + ((eq flag 'vector*) + (list 'apply '(function vector) thing)) (t (cons flag thing)))) (provide 'backquote) -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Correct some bugs on bignum, non-bignum builds, lisp_to_uid_t() 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1531274778 -3600 # Wed Jul 11 03:06:18 2018 +0100 # Node ID dde704f40544aa0fe8eecbf2b92fbdbb7eeeb057 # Parent 8d3aef8af4dfcc40d85867e5494d24d8c637d5e9 Correct some bugs on bignum, non-bignum builds, lisp_to_uid_t() src/ChangeLog addition: 2018-07-11 Aidan Kehoe <kehoea(a)parhasard.net> * data.c: * data.c (LISP_INTEGER_TO_C_TYPE): * data.c (C_TYPE_TO_LISP_INTEGER): * number.h: * number.h (bignum_fits_emacs_uint_p): Correct a couple of bugs in lisp_to_uid_t() on bignum, non-bignum builds. Provide lisp_to_gid_t(), gid_t_to_lisp() too, not yet used. Add a couple of comments to make grepping for the definitions easier. diff -r 8d3aef8af4df -r dde704f40544 src/ChangeLog --- a/src/ChangeLog Thu Jul 05 21:58:01 2018 +0100 +++ b/src/ChangeLog Wed Jul 11 03:06:18 2018 +0100 ＠＠ -1,3 +1,16 ＠＠ +2018-07-11 Aidan Kehoe <kehoea(a)parhasard.net> + + * data.c: + * data.c (LISP_INTEGER_TO_C_TYPE): + * data.c (C_TYPE_TO_LISP_INTEGER): + * number.h: + * number.h (bignum_fits_emacs_uint_p): + Correct a couple of bugs in lisp_to_uid_t() on bignum, non-bignum + builds. + Provide lisp_to_gid_t(), gid_t_to_lisp() too, not yet used. + Add a couple of comments to make grepping for the definitions + easier. + 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * menubar.c (Fcompare_menu_text): diff -r 8d3aef8af4df -r dde704f40544 src/data.c --- a/src/data.c Thu Jul 05 21:58:01 2018 +0100 +++ b/src/data.c Wed Jul 11 03:06:18 2018 +0100 ＠＠ -4039,6 +4039,14 ＠＠ (objekt)); \ } \ \ + if (sizeof (c_type) >= SIZEOF_EMACS_INT && \ + (c_type) (-1) > 0 && \ + bignum_fits_emacs_uint_p (XBIGNUM_DATA (objekt))) \ + { \ + return (c_type) bignum_to_emacs_uint (XBIGNUM_DATA \ + (objekt)); \ + } \ + \ if (sizeof (c_type) >= sizeof (long long) && \ bignum_fits_llong_p (XBIGNUM_DATA (objekt))) \ { \ ＠＠ -4046,6 +4054,7 ＠＠ } \ \ if (sizeof (c_type) >= sizeof (long long) && \ + (c_type) (-1) > 0 && \ bignum_fits_ullong_p (XBIGNUM_DATA (objekt))) \ { \ return (c_type) bignum_to_ullong (XBIGNUM_DATA (objekt)); \ ＠＠ -4066,11 +4075,12 ＠＠ { \ EMACS_INT ival = XREALFIXNUM (objekt); \ \ - if (sizeof (c_type) >= sizeof (EMACS_INT) ? \ - ((c_type) ival < min_lisp_to_c_type || \ - (c_type) ival > max_lisp_to_c_type) : \ - (ival < (EMACS_INT) min_lisp_to_c_type || \ - ival > (EMACS_INT) max_lisp_to_c_type)) \ + if (((c_type)(-1) > 0 && ival < 0) || \ + (sizeof (c_type) >= sizeof (EMACS_INT) ? \ + ((c_type) ival < min_lisp_to_c_type || \ + (c_type) ival > max_lisp_to_c_type) : \ + (ival < (EMACS_INT) min_lisp_to_c_type || \ + ival > (EMACS_INT) max_lisp_to_c_type))) \ { \ args_out_of_range_3 (objekt, \ make_float (min_lisp_to_c_type), \ ＠＠ -4100,8 +4110,8 ＠＠ \ while (value) \ { \ + result = Fcons (make_fixnum (value & 0xFFFF), result); \ value = value >> 16; \ - result = Fcons (make_fixnum (value & 0xFFFF), result); \ } \ \ if (negative) \ ＠＠ -4224,9 +4234,14 ＠＠ } \ visibility Lisp_Object c_type##_to_lisp (c_type) -DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, OFF_T); - +/* Definitions for lisp_to_OFF_T, OFF_T_to_lisp: */ +DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, OFF_T); + +/* Definitions for lisp_to_uid_t, uid_t_to_lisp: */ DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, uid_t); + +/* Definitions for lisp_to_uid_t, uid_t_to_lisp: */ +DEFINE_C_INTEGER_TYPE_LISP_CONVERSION (extern, gid_t); /************************************************************************/ /* initialization */ diff -r 8d3aef8af4df -r dde704f40544 src/number.h --- a/src/number.h Thu Jul 05 21:58:01 2018 +0100 +++ b/src/number.h Wed Jul 11 03:06:18 2018 +0100 ＠＠ -100,18 +100,21 ＠＠ #if SIZEOF_EMACS_INT == SIZEOF_LONG # define bignum_fits_emacs_int_p(b) bignum_fits_long_p(b) +# define bignum_fits_emacs_uint_p(b) bignum_fits_ulong_p(b) # define bignum_to_emacs_int(b) bignum_to_long(b) # define bignum_to_emacs_uint(b) bignum_to_ulong(b) # define bignum_set_emacs_int bignum_set_long # define make_bignum_emacs_uint(b) make_bignum_un(b) #elif SIZEOF_EMACS_INT == SIZEOF_INT # define bignum_fits_emacs_int_p(b) bignum_fits_int_p(b) +# define bignum_fits_emacs_uint_p(b) bignum_fits_uint_p(b) # define bignum_to_emacs_int(b) bignum_to_int(b) # define bignum_to_emacs_uint(b) bignum_to_uint(b) # define bignum_set_emacs_int bignum_set_long # define make_bignum_emacs_uint(b) make_bignum_un(b) #else # define bignum_fits_emacs_int_p(b) bignum_fits_llong_p(b) +# define bignum_fits_emacs_uint_p(b) bignum_fits_ullong_p(b) # define bignum_to_emacs_int(b) bignum_to_llong(b) # define bignum_to_emacs_uint(b) bignum_to_ullong(b) # define bignum_set_emacs_int bignum_set_llong ＠＠ -443,6 +446,9 ＠＠ extern Lisp_Object uid_t_to_lisp (uid_t); extern uid_t lisp_to_uid_t (Lisp_Object); +extern Lisp_Object gid_t_to_lisp (gid_t); +extern gid_t lisp_to_gid_t (Lisp_Object); + #ifdef WITH_NUMBER_TYPES /* promote_args() *always* converts a marker argument to a fixnum. -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Don't dynamically bind argument names as often, #'cl-defsubst-expand 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530823924 -3600 # Thu Jul 05 21:52:04 2018 +0100 # Node ID 3c7e9dbadbbcd1d3a85c798275e0cfb283519955 # Parent e26b605e4e9cddbb7645b9b8137612cf9d6b0f77 Don't dynamically bind argument names as often, #'cl-defsubst-expand lisp/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * cl-macs.el (defsubst*): Document that within BODY the variable names within ARGLIST may not have dynamic binding. Don't check BODY for side effects, our check is inaccurate and the result was used, inaccurately, within cl-defsubst-expand to decide whether argument names needed binding. * cl-macs.el (cl-defsubst-expand): Don't bind arguments using let if the UNSAFE argument is supplied, that gives byte-compile warnings that don't help anyone. diff -r e26b605e4e9c -r 3c7e9dbadbbc lisp/ChangeLog --- a/lisp/ChangeLog Thu Jul 05 09:03:26 2018 +0100 +++ b/lisp/ChangeLog Thu Jul 05 21:52:04 2018 +0100 ＠＠ -1,3 +1,15 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * cl-macs.el (defsubst*): + Document that within BODY the variable names within ARGLIST may + not have dynamic binding. + Don't check BODY for side effects, our check is inaccurate and the + result was used, inaccurately, within cl-defsubst-expand to decide + whether argument names needed binding. + * cl-macs.el (cl-defsubst-expand): + Don't bind arguments using let if the UNSAFE argument is supplied, + that gives byte-compile warnings that don't help anyone. + 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * map-ynp.el (normalize-menu-text): Add an autoload for this diff -r e26b605e4e9c -r 3c7e9dbadbbc lisp/cl-macs.el --- a/lisp/cl-macs.el Thu Jul 05 09:03:26 2018 +0100 +++ b/lisp/cl-macs.el Thu Jul 05 21:52:04 2018 +0100 ＠＠ -3161,15 +3161,18 ＠＠ (defmacro defsubst* (name arglist &optional docstring &rest body) "Define NAME as a function. + Like `defun', except the function is automatically declared `inline', ARGLIST allows full Common Lisp conventions, and BODY is implicitly -surrounded by (block NAME ...)." +surrounded by (block NAME ...). + +`defsubst*' also has the caveat that, within BODY, there is no guarantee that +the symbols within ARGLIST will have dynamic bindings, they may have a lexical +expansion only." (let* ((argns (cl-arglist-args arglist)) (p argns) (exec-body (if (or (stringp docstring) (null docstring)) body - (cons docstring body))) - (pbody (cons 'progn exec-body)) - (unsafe (not (cl-safe-expr-p pbody)))) + (cons docstring body)))) (while (and p (eq (cl-expr-contains arglist (car p)) 1)) (pop p)) (list 'progn (if (or p (memq '&rest arglist)) ＠＠ -3182,14 +3185,15 ＠＠ (cons '&cl-quote arglist)) (list* 'cl-defsubst-expand (list 'quote argns) (list 'quote (list* 'block name exec-body)) - (not (or unsafe (cl-expr-access-order pbody argns))) - (and (memq '&key arglist) 'cl-whole) unsafe argns))) + (not (cl-expr-access-order (cons 'progn exec-body) + argns)) + (and (memq '&key arglist) 'cl-whole) nil argns))) (list* 'defun* name arglist docstring body)))) -(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) +(defun cl-defsubst-expand (argns body simple whole ignored &rest argvs) (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole - (if (cl-simple-exprs-p argvs) + (if (and (not simple) (cl-simple-exprs-p argvs)) (setq simple t)) (let* ((symbol-macros nil) (lets (mapcan #'(lambda (argn argv) ＠＠ -3197,24 +3201,28 ＠＠ (progn ;; Avoid infinite loop on symbol macro ;; expansion: - (or (block find + (if (block find (subst nil argn argvs :test #'(lambda (elt tree) ;; Give nil if argn is ;; in argvs somewhere: (if (eq elt tree) (return-from find))))) - (let ((copy-symbol (copy-symbol argn))) - ;; Rename ARGN within BODY so it - ;; doesn't conflict with its value - ;; in the including scope: - (setq body - (cl-macroexpand-all - body `((,(eq-hash argn) - ,copy-symbol t))) - argn copy-symbol))) - (push (list argn argv t) symbol-macros) - (and unsafe (list (list argn argv)))) + ;; No infinite loop going to happen, + ;; use a symbol macro in the normal + ;; way: + (push (list argn argv t) symbol-macros) + (let ((copy-symbol (copy-symbol argn))) + ;; Rename ARGN within BODY now so it + ;; doesn't conflict with its value in + ;; the including scope: + (setq body + (cl-macroexpand-all + body `((,(eq-hash argn) + ,copy-symbol t)))) + (push (list copy-symbol argv t) + symbol-macros))) + nil) (list (list argn argv)))) argns argvs))) `(let ,lets -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Silence an extensive list of byte-compiler warnings, lisp/ 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530824281 -3600 # Thu Jul 05 21:58:01 2018 +0100 # Node ID 8d3aef8af4dfcc40d85867e5494d24d8c637d5e9 # Parent 3c7e9dbadbbcd1d3a85c798275e0cfb283519955 Silence an extensive list of byte-compiler warnings, lisp/ lisp/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> Silence an extensive list of byte compile warnings, chiefly through use of #'globally-declare-fboundp and #'globally-declare-boundp. Also prefer (default-device 'x) to (default-x-device), since the former always exists when byte compiling. * autoload.el: * autoload.el (make-autoload): * autoload.el (autoload-make-autoload-operators): New. * autoload.el (autoload-make-autoload-complex-operators): New. Be a bit better about silencing byte compile warnings regarding autoload-make-autoload-operators here * behavior.el: * behavior.el (unless): * buff-menu.el: * buff-menu.el (unless): * cmdloop.el: * cmdloop.el (unless): * cmdloop.el (yes-or-no-p): * cmdloop.el (y-or-n-p): * cus-edit.el: * cus-edit.el (unless): * custom.el (custom-theme-reset-internal-face): * custom.el (custom-define-hook): * dialog-items.el: * dialog-items.el (unless): * dialog.el: * easymenu.el: * easymenu.el (unless): * font-menu.el: * font-menu.el (unless): * font.el: * font.el (fontconfig): * font.el (font-xft-font-regexp): * font.el (font-xft-font-regexp)): New. * font.el (x-font-build-cache): * font.el (xft-font-create-object): * fontconfig.el (fc-try-font): * fontconfig.el (fc-find-available-font-families): * fontconfig.el (fc-find-available-weights-for-family): * gnuserv.el: * gnuserv.el (unless): * gtk-faces.el: * gtk-faces.el (unless): * gtk-faces.el (gtk-convert-font-from-xlfd): * help.el: * help.el (unless): * help.el (help): * hyper-apropos.el: * hyper-apropos.el (unless): * info.el: * info.el (unless): * lisp-mode.el: * lisp-mode.el (unless): * menubar-items.el: * menubar-items.el (unless): * menubar.el: * menubar.el (unless): * minibuf.el: * minibuf.el (unless): * minibuf.el (insert-default-directory): * mode-motion.el: * mode-motion.el (mouse): * modeline.el: * modeline.el (unless): * mouse.el: * mouse.el (unless): * mouse.el (shift): * msw-select.el: * msw-select.el (unless): * mule/mule-charset.el (do-define-charset-tags): * mule/mule-charset.el (script): * mwheel.el: * mwheel.el (unless): * occur.el: * occur.el (unless): * package-ui.el: * package-ui.el (unless): * picture.el: * picture.el (unless): * printer.el: * printer.el (unless): * scrollbar.el: * scrollbar.el (unless): * select.el: * select.el (unless): * startup.el: * startup.el (unless): * toolbar-items.el: * toolbar-items.el (unless): * toolbar.el: * toolbar.el (unless): * userlock.el: * userlock.el (unless): * userlock.el (ask-user-about-lock-minibuf): * wid-edit.el: * wid-edit.el (unless): * x-faces.el (x-make-font-bold-xft): * x-faces.el (x-make-font-unbold-xft): * x-faces.el (x-make-font-italic-xft): * x-faces.el (x-make-font-unitalic-xft): * x-faces.el (x-font-size-xft): * x-faces.el (x-find-xft-font-of-size): * x-font-menu.el: * x-font-menu.el (unless): * x-init.el: * x-init.el (unless): * x-mouse.el: * x-mouse.el (unless): * x-scrollbar.el: * x-scrollbar.el (unless): * x-scrollbar.el (x-init-scrollbar-from-resources): * x-win-sun.el: * x-win-sun.el (unless): * x-win-sun.el (x-win-init-sun): * x-win-xfree86.el: * x-win-xfree86.el (unless): diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/ChangeLog --- a/lisp/ChangeLog Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/ChangeLog Thu Jul 05 21:58:01 2018 +0100 ＠＠ -1,3 +1,125 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + + Silence an extensive list of byte compile warnings, chiefly + through use of #'globally-declare-fboundp and + #'globally-declare-boundp. + + Also prefer (default-device 'x) to (default-x-device), since the + former always exists when byte compiling. + + * autoload.el: + * autoload.el (make-autoload): + * autoload.el (autoload-make-autoload-operators): New. + * autoload.el (autoload-make-autoload-complex-operators): New. + Be a bit better about silencing byte compile warnings regarding + autoload-make-autoload-operators here + + * behavior.el: + * behavior.el (unless): + * buff-menu.el: + * buff-menu.el (unless): + * cmdloop.el: + * cmdloop.el (unless): + * cmdloop.el (yes-or-no-p): + * cmdloop.el (y-or-n-p): + * cus-edit.el: + * cus-edit.el (unless): + * custom.el (custom-theme-reset-internal-face): + * custom.el (custom-define-hook): + * dialog-items.el: + * dialog-items.el (unless): + * dialog.el: + * easymenu.el: + * easymenu.el (unless): + * font-menu.el: + * font-menu.el (unless): + * font.el: + * font.el (fontconfig): + * font.el (font-xft-font-regexp): + * font.el (font-xft-font-regexp)): New. + * font.el (x-font-build-cache): + * font.el (xft-font-create-object): + * fontconfig.el (fc-try-font): + * fontconfig.el (fc-find-available-font-families): + * fontconfig.el (fc-find-available-weights-for-family): + * gnuserv.el: + * gnuserv.el (unless): + * gtk-faces.el: + * gtk-faces.el (unless): + * gtk-faces.el (gtk-convert-font-from-xlfd): + * help.el: + * help.el (unless): + * help.el (help): + * hyper-apropos.el: + * hyper-apropos.el (unless): + * info.el: + * info.el (unless): + * lisp-mode.el: + * lisp-mode.el (unless): + * menubar-items.el: + * menubar-items.el (unless): + * menubar.el: + * menubar.el (unless): + * minibuf.el: + * minibuf.el (unless): + * minibuf.el (insert-default-directory): + * mode-motion.el: + * mode-motion.el (mouse): + * modeline.el: + * modeline.el (unless): + * mouse.el: + * mouse.el (unless): + * mouse.el (shift): + * msw-select.el: + * msw-select.el (unless): + * mule/mule-charset.el (do-define-charset-tags): + * mule/mule-charset.el (script): + * mwheel.el: + * mwheel.el (unless): + * occur.el: + * occur.el (unless): + * package-ui.el: + * package-ui.el (unless): + * picture.el: + * picture.el (unless): + * printer.el: + * printer.el (unless): + * scrollbar.el: + * scrollbar.el (unless): + * select.el: + * select.el (unless): + * startup.el: + * startup.el (unless): + * toolbar-items.el: + * toolbar-items.el (unless): + * toolbar.el: + * toolbar.el (unless): + * userlock.el: + * userlock.el (unless): + * userlock.el (ask-user-about-lock-minibuf): + * wid-edit.el: + * wid-edit.el (unless): + * x-faces.el (x-make-font-bold-xft): + * x-faces.el (x-make-font-unbold-xft): + * x-faces.el (x-make-font-italic-xft): + * x-faces.el (x-make-font-unitalic-xft): + * x-faces.el (x-font-size-xft): + * x-faces.el (x-find-xft-font-of-size): + * x-font-menu.el: + * x-font-menu.el (unless): + * x-init.el: + * x-init.el (unless): + * x-mouse.el: + * x-mouse.el (unless): + * x-scrollbar.el: + * x-scrollbar.el (unless): + * x-scrollbar.el (x-init-scrollbar-from-resources): + * x-win-sun.el: + * x-win-sun.el (unless): + * x-win-sun.el (x-win-init-sun): + * x-win-xfree86.el: + * x-win-xfree86.el (unless): + 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * cl-macs.el (defsubst*): diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/autoload.el --- a/lisp/autoload.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/autoload.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -228,36 +228,35 ＠＠ ; package. (ignore-errors (require 'autoload-operators)) -; As autoload-operators is new, provide stopgap measure for a while. -(if (not (boundp 'autoload-make-autoload-operators)) - (progn - (defvar autoload-make-autoload-operators - '(defun define-skeleton defmacro define-derived-mode define-generic-mode - easy-mmode-define-minor-mode easy-mmode-define-global-mode - define-minor-mode defun* defmacro*) - "`defun'-like operators that use `autoload' to load the library.") - - (defvar autoload-make-autoload-complex-operators - '(easy-mmode-define-minor-mode easy-mmode-define-global-mode - define-minor-mode) - "`defun'-like operators to macroexpand before using `autoload'.") - - (put 'autoload 'doc-string-elt 3) - (put 'defun 'doc-string-elt 3) - (put 'defun* 'doc-string-elt 3) - (put 'defvar 'doc-string-elt 3) - (put 'defcustom 'doc-string-elt 3) - (put 'defconst 'doc-string-elt 3) - (put 'defmacro 'doc-string-elt 3) - (put 'defmacro* 'doc-string-elt 3) - (put 'defsubst 'doc-string-elt 3) - (put 'define-skeleton 'doc-string-elt 2) - (put 'define-derived-mode 'doc-string-elt 4) - (put 'easy-mmode-define-minor-mode 'doc-string-elt 2) - (put 'define-minor-mode 'doc-string-elt 2) - (put 'define-generic-mode 'doc-string-elt 7) - ;; defin-global-mode has no explicit docstring. - (put 'easy-mmode-define-global-mode 'doc-string-elt 1000))) +; As autoload-operators is new, provide stopgap measure for a +; while. This defvar won't override the value from +; autoload-operators.el, if that has been loaded. +(defvar autoload-make-autoload-operators + '(defun define-skeleton defmacro define-derived-mode define-generic-mode + easy-mmode-define-minor-mode easy-mmode-define-global-mode + define-minor-mode defun* defmacro*)) + +(defvar autoload-make-autoload-complex-operators + '(easy-mmode-define-minor-mode easy-mmode-define-global-mode + define-minor-mode)) + +(unless (featurep 'autoload-operators) + (put 'autoload 'doc-string-elt 3) + (put 'defun 'doc-string-elt 3) + (put 'defun* 'doc-string-elt 3) + (put 'defvar 'doc-string-elt 3) + (put 'defcustom 'doc-string-elt 3) + (put 'defconst 'doc-string-elt 3) + (put 'defmacro 'doc-string-elt 3) + (put 'defmacro* 'doc-string-elt 3) + (put 'defsubst 'doc-string-elt 3) + (put 'define-skeleton 'doc-string-elt 2) + (put 'define-derived-mode 'doc-string-elt 4) + (put 'easy-mmode-define-minor-mode 'doc-string-elt 2) + (put 'define-minor-mode 'doc-string-elt 2) + (put 'define-generic-mode 'doc-string-elt 7) + ;; defin-global-mode has no explicit docstring. + (put 'easy-mmode-define-global-mode 'doc-string-elt 1000)) (defun make-autoload (form file) "Turn FORM into an autoload or defvar for source file FILE. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/behavior.el --- a/lisp/behavior.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/behavior.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -165,6 +165,10 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'menubar) + '(submenu-generate-accelerator-spec menu-split-long-menu menu-sort-menu))) + ;; Hash table mapping behavior names to property lists, with entries for ;; :group, :custom-group, :short-doc, :require, :enable, :disable, ;; and :commands. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/buff-menu.el --- a/lisp/buff-menu.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/buff-menu.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -47,6 +47,10 ＠＠ ;;; Code: +(globally-declare-fboundp (unless (featurep 'mouse) '(mouse-set-point))) + +(globally-declare-fboundp (unless (featurep 'menubar) '(popup-menu))) + ;;;Trying to preserve the old window configuration works well in ;;;simple scenarios, when you enter the buffer menu, use it, and exit it. ;;;But it does strange things when you switch back to the buffer list buffer diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/cmdloop.el --- a/lisp/cmdloop.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/cmdloop.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -32,6 +32,9 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'dialog) '(yes-or-no-p-dialog-box))) + (defun recursion-depth () "Return the current depth in recursive edits." (+ command-loop-level (minibuffer-depth))) ＠＠ -509,7 +512,7 ＠＠ ;; and-fboundp is redundant, since yes-or-no-p-dialog-box is only ;; bound if (featurep 'dialog). But it eliminates a compile-time ;; warning. - (and-fboundp 'yes-or-no-p-dialog-box (yes-or-no-p-dialog-box prompt)) + (yes-or-no-p-dialog-box prompt) (yes-or-no-p-minibuf prompt))) (defun y-or-n-p (prompt) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/cus-edit.el --- a/lisp/cus-edit.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/cus-edit.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -49,6 +49,9 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'menubar) '(menu-split-long-menu))) + (require 'cus-face) (require 'wid-edit) (require 'easymenu) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/custom.el --- a/lisp/custom.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/custom.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -42,6 +42,7 ＠＠ (provide 'custom) (autoload 'custom-declare-face "cus-face") +(autoload 'custom-theme-reset-internal-face "cus-face") (require 'widget) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/dialog-items.el --- a/lisp/dialog-items.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/dialog-items.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -25,6 +25,8 ＠＠ ;;; Commentary: +(globally-declare-fboundp (unless (featurep 'dialog) '(make-dialog-box))) + ;; ;; Simple search dialog ;; diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/dialog.el --- a/lisp/dialog.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/dialog.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -39,6 +39,13 ＠＠ ;; yes-or-no-p-dialog-box, but such code is difficult to write and test. ;;; Code: + +(globally-declare-fboundp + (unless (featurep 'dialog) '(make-dialog-box-internal))) + +(globally-declare-boundp + (unless (featurep 'dialog) '(dialog-frame-plist))) + (defun yes-or-no-p-dialog-box (prompt) "Ask user a yes-or-no question with a popup dialog box. Return t if the answer is \"yes\". diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/easymenu.el --- a/lisp/easymenu.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/easymenu.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -82,6 +82,13 ＠＠ ;;; Code: +(globally-declare-boundp (unless (featurep 'menubar) '(current-menubar))) + +(globally-declare-fboundp + (unless (featurep 'menubar) + '(set-buffer-menubar add-menu delete-menu-item add-menu-button + find-menu-item))) + ;; ;;;###autoload (defmacro easy-menu-define (symbol maps doc menu) "Define a menu bar submenu in maps MAPS, according to MENU. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/font-menu.el --- a/lisp/font-menu.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/font-menu.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -117,6 +117,12 ＠＠ ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0") +(globally-declare-fboundp + (unless (featurep 'menubar) + '(menu-split-long-menu menu-item-strip-accelerator-spec enable-menu-item + disable-menu-item select-toggle-menu-item deselect-toggle-menu-item + submenu-generate-accelerator-spec))) + ;;;###autoload (defcustom font-menu-ignore-scaled-fonts nil "*If non-nil, the font menu shows only bitmap fonts. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/font.el --- a/lisp/font.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/font.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -59,6 +59,7 ＠＠ mswindows-font-regexp)) (require 'cl) +(require 'fontconfig) (eval-and-compile (defvar device-fonts-cache) ＠＠ -560,6 +561,8 ＠＠ ) "A list of font family mappings on X devices.") +(defvar font-xft-font-regexp) + (defun x-font-create-object (fontname &optional device) "Return a font descriptor object for FONTNAME, appropriate for X devices." (let ((case-fold-search t)) ＠＠ -713,7 +716,7 ＠＠ (while fonts (setq cur (car fonts) fonts (cdr fonts) - plist (cl-gethash (car (font-family cur)) hash-table)) + plist (gethash (car (font-family cur)) hash-table)) (if (not (memq (font-weight cur) (plist-get plist 'weights))) (setq plist (plist-put plist 'weights (cons (font-weight cur) (plist-get plist 'weights))))) ＠＠ -726,7 +729,7 ＠＠ (if (and (font-italic-p cur) (not (memq 'italic (plist-get plist 'styles)))) (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles))))) - (cl-puthash (car (font-family cur)) plist hash-table)) + (puthash (car (font-family cur)) plist hash-table)) hash-table)) ＠＠ -785,7 +788,7 ＠＠ Optional DEVICE defaults to `default-x-device'." (let* ((name fontname) - (device (or device (default-x-device))) + (device (or device (default-device 'x))) ;; names generated by font-instance-truename may contain ;; unparseable object specifications (pattern (fc-font-match device (fc-name-parse-harder name))) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/fontconfig.el --- a/lisp/fontconfig.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/fontconfig.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -474,7 +474,7 ＠＠ FONT may be a fontconfig pattern object or a fontconfig font name (a string). Optional DEVICE is the device object to query, defaulting to the currently selected device." - (fc-list-fonts-pattern-objects (or device (default-x-device)) + (fc-list-fonts-pattern-objects (or device (default-device 'x)) (if (fc-pattern-p font) font (fc-name-parse font)) ＠＠ -488,7 +488,7 ＠＠ (defun fc-find-available-font-families (&optional device filter-fun) "Find all available font families." - (let ((device (or device (default-x-device))) + (let ((device (or device (default-device 'x))) (pattern (make-fc-pattern)) (objectset '("family" "style"))) (let* ((all-fonts ＠＠ -503,7 +503,7 ＠＠ (defun fc-find-available-weights-for-family (family &optional style device) "Find available weights for font FAMILY." - (let* ((device (or device (default-x-device))) + (let* ((device (or device (default-device 'x))) (pattern (make-fc-pattern)) (objectset '("weight"))) (fc-pattern-add-family pattern family) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/gnuserv.el --- a/lisp/gnuserv.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/gnuserv.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -81,6 +81,12 ＠＠ ;;; Code: +(globally-declare-boundp (unless (featurep 'menubar) '(current-menubar))) + +(globally-declare-fboundp + (unless (featurep 'menubar) + '(set-buffer-menubar add-menu-button delete-menu-item))) + (defgroup gnuserv nil "The gnuserv suite of programs to talk to Emacs from outside." :group 'environment diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/gtk-faces.el --- a/lisp/gtk-faces.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/gtk-faces.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -30,17 +30,23 ＠＠ ;; This file is dumped with XEmacs (when GTK support is compiled in). (globally-declare-fboundp - '(gtk-init-pointers - gtk-font-selection-dialog-new - gtk-widget-set-sensitive gtk-font-selection-dialog-apply-button - gtk-signal-connect gtk-main-quit - gtk-font-selection-dialog-ok-button - gtk-font-selection-dialog-get-font-name gtk-widget-destroy - font-menu-set-font font-family font-size - gtk-font-selection-dialog-cancel-button gtk-widget-show-all - gtk-main gtk-style-info)) + (unless (valid-device-type-p 'gtk) + '(gtk-init-pointers + gtk-font-selection-dialog-new + gtk-widget-set-sensitive gtk-font-selection-dialog-apply-button + gtk-signal-connect gtk-main-quit + gtk-font-selection-dialog-ok-button + gtk-font-selection-dialog-get-font-name gtk-widget-destroy + font-menu-set-font font-family font-size + gtk-font-selection-dialog-cancel-button gtk-widget-show-all + gtk-main gtk-style-info))) -(globally-declare-boundp '(gtk-major-version gtk-fallback-font-name)) +(globally-declare-boundp + (unless (valid-device-type-p 'gtk) + '(gtk-major-version gtk-fallback-font-name))) + +(autoload 'x-font-xlfd-font-name-p "x-faces") +(autoload 'x-font-size "x-faces") (eval-when-compile (defmacro gtk-style-munge-face (face attribute value) ＠＠ -198,6 +204,7 ＠＠ (weight (match-string 1 font)) (slant (match-string 2 font)) (size (x-font-size font))) + (defvar x-font-regexp-foundry-and-family) (if (string-match x-font-regexp-foundry-and-family font) (setq family (capitalize (match-string 1 font))) (setq family gtk-fallback-font-name)) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/help.el --- a/lisp/help.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/help.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -39,6 +39,12 ＠＠ ;; or run interpreted, but not when the compiled code is loaded. (eval-when-compile (require 'help-macro)) +(globally-declare-boundp + (unless (featurep 'menubar) '(last-popup-menu-event))) + +(globally-declare-fboundp + (unless (featurep 'toolbar) '(toolbar-button-callback))) + (require 'loadhist) ;; For symbol-file. (defgroup help nil diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/hyper-apropos.el --- a/lisp/hyper-apropos.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/hyper-apropos.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -64,6 +64,9 ＠＠ ;;; Code: +(globally-declare-fboundp (unless (featurep 'menubar) '(popup-menu))) +(globally-declare-fboundp (unless (featurep 'mouse) '(mouse-set-point))) + (defgroup hyper-apropos nil "Hypertext emacs lisp documentation interface." :group 'docs diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/info.el --- a/lisp/info.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/info.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -317,6 +317,16 ＠＠ (eval-when-compile (condition-case nil (require 'browse-url) (error nil))) +(globally-declare-fboundp + (unless (featurep 'toolbar) '(toolbar-make-button-list))) + +(globally-declare-boundp + (unless (featurep 'toolbar) '(toolbar-info-frame default-toolbar + toolbar-icon-directory))) + +(globally-declare-fboundp (unless (featurep 'menubar) '(popup-menu))) +(globally-declare-boundp (unless (featurep 'menubar) '(popup-menu-titles))) + (defgroup info nil "The info package for Emacs." :group 'help diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/lisp-mode.el --- a/lisp/lisp-mode.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/lisp-mode.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -33,6 +33,11 ＠＠ ;;; Code: +(globally-declare-boundp (unless (featurep 'menubar) '(current-menubar))) + +(globally-declare-fboundp + (unless (featurep 'menubar) '(set-buffer-menubar add-submenu))) + (defgroup lisp nil "Lisp support, including Emacs Lisp." :group 'languages diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/menubar-items.el --- a/lisp/menubar-items.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/menubar-items.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -52,6 +52,14 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'menubar) + '(menu-split-long-menu-and-sort submenu-generate-accelerator-spec + menu-split-long-menu add-menu-button menu-item-generate-accelerator-spec + set-menubar))) + +(globally-declare-boundp (unless (featurep 'menubar) '(current-menubar))) + (defun Menubar-items-truncate-history (list count label-length) "Truncate a history LIST to first COUNT items. Return a list of (label value) lists with labels truncated to last diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/menubar.el --- a/lisp/menubar.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/menubar.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -32,6 +32,13 ＠＠ ;;; Code: +(globally-declare-boundp + (unless (featurep 'menubar) + '(current-menubar menu-accelerator-map popup-menu-titles))) + +(globally-declare-fboundp + (unless (featurep 'menubar) '(compare-menu-text popup-menu popup-up-p))) + (defgroup menu nil "Input from the menus." :group 'environment) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/minibuf.el --- a/lisp/minibuf.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/minibuf.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -40,11 +40,19 ＠＠ (require 'cl) +(globally-declare-fboundp + (unless (featurep 'window-system) + '(mode-motion-highlight-internal default-mouse-track-beginning-of-word + default-mouse-track-end-of-word make-dialog-frame insert-gui-button + make-gui-button get-dialog-box-response))) + +(globally-declare-boundp + (unless (featurep 'window-system) '(mode-motion-hook))) + (defgroup minibuffer nil "Controlling the behavior of the minibuffer." :group 'environment) - (defcustom insert-default-directory t "*Non-nil means when reading a filename start with default dir in minibuffer." :type 'boolean diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/mode-motion.el --- a/lisp/mode-motion.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/mode-motion.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -28,6 +28,8 ＠＠ ;;; Code: +(require 'mouse) + (defvar mode-motion-hook nil "Function or functions which are called whenever the mouse moves. Each function must take a single argument of the motion event. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/modeline.el --- a/lisp/modeline.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/modeline.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -29,6 +29,12 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'mouse) '(mouse-bury-buffer mouse-unbury-buffer))) + +(globally-declare-fboundp + (unless (featurep 'menubar) '(popup-menu-and-execute-in-window))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; General mouse modeline stuff ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/mouse.el --- a/lisp/mouse.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/mouse.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -39,6 +39,15 ＠＠ ;;; Code: +(globally-declare-boundp + (unless (featurep 'toolbar) + '(toolbar-active last-pressed-toolbar-button toolbar-help-enabled))) + +(globally-declare-fboundp + (unless (featurep 'toolbar) + '(toolbar-button-help-string release-previous-toolbar-button + press-toolbar-button toolbar-button-enabled-p))) + (provide 'mouse) (global-set-key 'button1 'mouse-track) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/msw-select.el --- a/lisp/msw-select.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/msw-select.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -30,6 +30,9 ＠＠ ;;; Code: +(globally-declare-boundp + (unless (featurep 'mouse) '(mouse-track-rectangle-p))) + (defun mswindows-paste-clipboard () "Insert the current contents of the mswindows clipboard at point, replacing the active selection if there is one." diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/mule/mule-charset.el --- a/lisp/mule/mule-charset.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/mule/mule-charset.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -556,15 +556,14 ＠＠ ;; should specify short-form tags, which will have CATEGORY added to make ;; them full-form. (loop for (class parents doc) in stuff - for parents = (or parents category) - for parents = (if (listp parents) parents (list parents)) - do - (define-charset-tag - (intern (format "%s/%s" class category)) - :parent (loop for par in parents - collect (if (eq par category) category - (intern (format "%s/%s" par category)))) - :doc-string doc))) + do (progn (setq parents (or parents category) + parents (if (listp parents) parents (list parents))) + (define-charset-tag + (intern (format "%s/%s" class category)) + :parent (loop for par in parents + collect (if (eq par category) category + (intern (format "%s/%s" par category)))) + :doc-string doc)))) ;; define classes of scripts diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/mwheel.el --- a/lisp/mwheel.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/mwheel.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -37,6 +37,11 ＠＠ ;;; Code: +(globally-declare-boundp + (unless (featurep 'mouse) + '(mouse-track-up-time mouse-track-multi-click-time + mouse-track-click-count))) + (require 'custom) ;; XEmacs; I don't feel it's reasonable to support a minor mode for the mouse diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/occur.el --- a/lisp/occur.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/occur.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -23,6 +23,12 ＠＠ ;;; Synched up with: FSF 22.0.50.1 (CVS) +(globally-declare-fboundp + (unless (featurep 'window-system) '(mouse-set-point))) + +(globally-declare-boundp + (unless (featurep 'window-system) '(mode-motion-hook))) + (require 'next-error) (defun query-replace-descr (string) (mapconcat 'isearch-text-char-description string "")) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/package-ui.el --- a/lisp/package-ui.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/package-ui.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -22,6 +22,14 ＠＠ ;;; Synched up with: Not in FSF +(globally-declare-fboundp + (unless (featurep 'menubar) + '(set-menubar-dirty-flag popup-menu popup-up-p set-buffer-menubar + add-submenu))) + +(globally-declare-boundp (unless (featurep 'menubar) '(current-menubar))) + + (require 'package-get) ;; which, in turn, requires 'package-admin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/picture.el --- a/lisp/picture.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/picture.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -37,6 +37,12 ＠＠ ;;; Code: +(globally-declare-fboundp (unless (featurep 'mouse) '(mouse-set-point))) + +(globally-declare-boundp + (unless (featurep 'mouse) '(mouse-yank-at-point mouse-track-rectangle-p))) + + (defun move-to-column-force (column) "Move to column COLUMN in current line. Differs from `move-to-column' in that it creates or modifies whitespace diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/printer.el --- a/lisp/printer.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/printer.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -32,6 +32,8 ＠＠ ;; This file is dumped with XEmacs. +(globally-declare-fboundp (unless (featurep 'dialog) '(make-dialog-box))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; generic printing code ;; diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/scrollbar.el --- a/lisp/scrollbar.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/scrollbar.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -28,6 +28,13 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'scrollbar) '(scrollbar-set-hscroll))) + +(globally-declare-boundp + (unless (featurep 'scrollbar) + '(vertical-scrollbar-visible-p horizontal-scrollbar-visible-p))) + ;; added for the options menu - dverna (defcustom scrollbars-visible-p t "Whether the scrollbars are globally visible. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/select.el --- a/lisp/select.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/select.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -31,6 +31,11 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'window-system) + '(default-mouse-track-next-move-rect + mouse-track-activate-rectangular-selection))) + ;; We prefer UTF8_STRING to COMPOUND_TEXT because, even though the latter ;; gives us more information when taking data from other XEmacs invocations, ;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/startup.el --- a/lisp/startup.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/startup.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -65,6 +65,12 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'toolbar) '(init-toolbar-location init-toolbar))) + +(globally-declare-fboundp + (unless (featurep 'menubar) '(init-menubar-at-startup))) + (setq top-level '(normal-top-level)) (defvar command-line-processed nil "t once command line has been processed") diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/toolbar-items.el --- a/lisp/toolbar-items.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/toolbar-items.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -35,6 +35,17 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'dialog) '(make-dialog-box))) + +(globally-declare-fboundp + (unless (featurep 'toolbar) '(toolbar-make-button-list))) + +(globally-declare-boundp + (unless (featurep 'toolbar) + '(default-toolbar initial-toolbar-spec toolbar-icon-directory))) + + (defgroup toolbar nil "Configure XEmacs Toolbar functions and properties" :group 'environment) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/toolbar.el --- a/lisp/toolbar.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/toolbar.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -29,6 +29,16 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'toolbar) + '(set-default-toolbar-position set-toolbar-button-down-flag + toolbar-button-enabled-p toolbar-button-callback))) + +(globally-declare-boundp + (unless (featurep 'toolbar) + '(default-toolbar-visible-p toolbar-buttons-captioned-p))) + + (defcustom toolbar-visible-p ;; added for the options menu - dverna apr. 98 (specifier-instance default-toolbar-visible-p) "*Whether the default toolbar is globally visible. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/userlock.el --- a/lisp/userlock.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/userlock.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -31,6 +31,9 ＠＠ ;;; Code: +(globally-declare-fboundp (unless (featurep 'dialog) '(make-dialog-box))) +(globally-declare-fboundp (unless (featurep 'window-system) '(popup-up-p))) + (define-error 'file-locked "File is locked" 'file-error) ; XEmacs (defun ask-user-about-lock-minibuf (filename other-user) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/wid-edit.el --- a/lisp/wid-edit.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/wid-edit.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -31,6 +31,15 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (featurep 'window-system) + '(make-gui-button get-popup-menu-response mouse-set-point))) + +(globally-declare-boundp + (unless (featurep 'window-system) + '(help-echo-owns-message gui-button-shadow-thickness))) + + (require 'widget) ;; XEmacs: autoload of `finder-commentary' is redundant. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-faces.el --- a/lisp/x-faces.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-faces.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -192,7 +192,7 ＠＠ (x-make-font-bold-core font device))) (defun x-make-font-bold-xft (font &optional device) - (let ((pattern (fc-font-match (or device (default-x-device)) + (let ((pattern (fc-font-match (or device (default-device 'x)) (fc-name-parse font)))) (if pattern (let ((size (fc-pattern-get-size pattern 0)) ＠＠ -236,7 +236,7 ＠＠ (x-make-font-unbold-core font device))) (defun x-make-font-unbold-xft (font &optional device) - (let ((pattern (fc-font-match (or device (default-x-device)) + (let ((pattern (fc-font-match (or device (default-device 'x)) (fc-name-parse font)))) (when pattern (fc-pattern-del-weight pattern) ＠＠ -266,7 +266,7 ＠＠ (x-make-font-italic-core font device))) (defun x-make-font-italic-xft (font &optional device) - (let ((pattern (fc-font-match (or device (default-x-device)) + (let ((pattern (fc-font-match (or device (default-device 'x)) (fc-name-parse font)))) (if pattern (let ((size (fc-pattern-get-size pattern 0)) ＠＠ -320,7 +320,7 ＠＠ (x-make-font-unitalic-core font device))) (defun x-make-font-unitalic-xft (font &optional device) - (let ((pattern (fc-font-match (or device (default-x-device)) + (let ((pattern (fc-font-match (or device (default-device 'x)) (fc-name-parse font)))) (when pattern (fc-pattern-del-slant pattern) ＠＠ -387,7 +387,7 ＠＠ ;; this is unbelievable &*＠# (defun x-font-size-xft (font) - (let ((pattern (fc-font-match (default-x-device) + (let ((pattern (fc-font-match (default-device 'x) (fc-name-parse font)))) (when pattern (let ((pixelsize (fc-pattern-get-pixelsize pattern 0))) ＠＠ -519,7 +519,7 ＠＠ (x-find-smaller-font-core font device))) (defun x-find-xft-font-of-size (font new-size-proc &optional device) - (let* ((pattern (fc-font-match (or device (default-x-device)) + (let* ((pattern (fc-font-match (or device (default-device 'x)) (fc-name-parse font)))) (when pattern (let ((size (fc-pattern-get-size pattern 0))) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-font-menu.el --- a/lisp/x-font-menu.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-font-menu.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -36,32 +36,19 ＠＠ (require 'fontconfig)) (globally-declare-boundp - '(x-font-regexp - x-font-regexp-foundry-and-family - x-font-regexp-spacing)) + (unless (valid-device-type-p 'x) + '(x-font-regexp x-font-regexp-foundry-and-family x-font-regexp-spacing))) -(globally-declare-boundp - '(charset-registries - fc-find-available-font-families - fc-find-available-weights-for-family - fc-font-match - fc-font-slant-translate-from-string - fc-font-slant-translate-to-string - fc-font-weight-translate-from-string - fc-font-weight-translate-to-string - fc-name-parse - fc-name-unparse - fc-pattern-add-family - fc-pattern-add-size - fc-pattern-add-slant - fc-pattern-add-weight - fc-pattern-get-family - fc-pattern-get-size - fc-pattern-get-slant - fc-pattern-get-successp - fc-pattern-get-weight - make-fc-pattern - xlfd-font-name-p)) +(globally-declare-fboundp + (unless (featurep 'font-mgr) + '(fc-find-available-weights-for-family fc-find-available-font-families + xlfd-font-name-p fc-font-match fc-name-parse fc-pattern-get-family + fc-pattern-get-successp fc-pattern-get-weight fc-pattern-get-size + fc-pattern-get-slant fc-font-weight-translate-to-string + fc-font-slant-translate-to-string make-fc-pattern fc-pattern-add-family + fc-pattern-add-weight fc-font-weight-translate-from-string + fc-pattern-add-size fc-pattern-add-slant + fc-font-slant-translate-from-string fc-name-unparse))) (defvar x-font-menu-registry-encoding nil "Registry and encoding to use with font menu fonts.") diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-init.el --- a/lisp/x-init.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-init.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -31,10 +31,19 ＠＠ ;;; Code: (globally-declare-fboundp - '(x-server-vendor x-init-specifier-from-resources init-mule-x-win)) + (unless (valid-device-type-p 'x) + '(x-server-vendor x-init-specifier-from-resources init-mule-x-win + x-keysym-hash-table))) (globally-declare-boundp - '(x-initial-argv-list x-app-defaults-directory)) + (unless (valid-device-type-p 'x) + '(x-initial-argv-list x-app-defaults-directory))) + +(globally-declare-boundp + (unless (featurep 'toolbar) + '(top-toolbar-height bottom-toolbar-height left-toolbar-width + right-toolbar-width top-toolbar-border-width bottom-toolbar-border-width + left-toolbar-border-width right-toolbar-border-width))) ;; If you want to change this variable, this is the place you must do it. ;; Do not set it to a string containing periods. X doesn't like that. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-mouse.el --- a/lisp/x-mouse.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-mouse.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -30,7 +30,14 ＠＠ ;;; Code: (globally-declare-fboundp - '(x-store-cutbuffer x-get-resource)) + (unless (valid-device-type-p 'x) '(x-store-cutbuffer x-get-resource))) + +(globally-declare-fboundp + (unless (featurep 'mouse) + '(mouse-set-point mouse-yank insert-selection mouse-track))) + +(globally-declare-boundp + (unless (featurep 'mouse) '(mouse-yank-at-point))) ;;(define-key global-map 'button2 'x-set-point-and-insert-selection) ;; This is reserved for use by Hyperbole. diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-scrollbar.el --- a/lisp/x-scrollbar.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-scrollbar.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -32,7 +32,13 ＠＠ ;;; Code: (globally-declare-fboundp - '(x-init-specifier-from-resources x-get-resource)) + (unless (valid-device-type-p 'x) + '(x-init-specifier-from-resources x-get-resource))) + +(globally-declare-boundp + (unless (featurep 'scrollbar) + '(scrollbar-width scrollbar-height scrollbar-on-top-p + scrollbar-on-left-p))) (defun x-init-scrollbar-from-resources (locale) (x-init-specifier-from-resources diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-win-sun.el --- a/lisp/x-win-sun.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-win-sun.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -63,7 +63,11 ＠＠ ;;; Code: (globally-declare-fboundp - '(x-keysym-on-keyboard-sans-modifiers-p)) + (unless (valid-device-type-p 'x) '(x-keysym-on-keyboard-sans-modifiers-p))) + +(globally-declare-boundp + (unless (valid-device-type-p 'x) + '(x-us-keymap-first-keycode x-us-keymap-description))) (defun x-win-init-sun (device) diff -r 3c7e9dbadbbc -r 8d3aef8af4df lisp/x-win-xfree86.el --- a/lisp/x-win-xfree86.el Thu Jul 05 21:52:04 2018 +0100 +++ b/lisp/x-win-xfree86.el Thu Jul 05 21:58:01 2018 +0100 ＠＠ -39,6 +39,13 ＠＠ ;;; Code: +(globally-declare-fboundp + (unless (valid-device-type-p 'x) '(x-keysym-hash-table))) + +(globally-declare-boundp + (unless (valid-device-type-p 'x) + '(x-us-keymap-first-keycode x-us-keymap-description))) + (defun x-win-init-xfree86 (device) ;; We know this keyboard is an XFree86 keyboard. As such, we can predict -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Make #'compare-menu-text more Mule-clean. 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530777806 -3600 # Thu Jul 05 09:03:26 2018 +0100 # Node ID e26b605e4e9cddbb7645b9b8137612cf9d6b0f77 # Parent 79bef0ac9919c5b37620c5dc80a75d1a8bf64b00 Make #'compare-menu-text more Mule-clean. src/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * menubar.c (Fcompare_menu_text): Make this function more Mule-clean, don't give the wrong answer when there are zero characters within the strings to be compared. tests/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * automated/lisp-tests.el (featurep): Basic tests of compare-menu-text. diff -r 79bef0ac9919 -r e26b605e4e9c src/ChangeLog --- a/src/ChangeLog Thu Jul 05 08:12:49 2018 +0100 +++ b/src/ChangeLog Thu Jul 05 09:03:26 2018 +0100 ＠＠ -1,3 +1,9 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * menubar.c (Fcompare_menu_text): + Make this function more Mule-clean, don't give the wrong answer + when there are zero characters within the strings to be compared. + 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * menubar.c: diff -r 79bef0ac9919 -r e26b605e4e9c src/menubar.c --- a/src/menubar.c Thu Jul 05 08:12:49 2018 +0100 +++ b/src/menubar.c Thu Jul 05 09:03:26 2018 +0100 ＠＠ -333,28 +333,57 ＠＠ */ (string1, string2)) { - Ibyte *p; - Ibyte *q; + const Ibyte *p, *pend; + const Ibyte *q, *qend; CHECK_STRING (string1); CHECK_STRING (string2); p = XSTRING_DATA (string1); + pend = p + XSTRING_LENGTH (string1); q = XSTRING_DATA (string2); + qend = q + XSTRING_LENGTH (string2); for (;;) { Ichar val; - if (*p == '%' && *(p + 1) == '%') - p++; - else if (*p == '%' && *(p + 1) == '_') - p += 2; - if (*q == '%' && *(q + 1) == '%') - q++; - else if (*q == '%' && *(q + 1) == '_') - q += 2; - if (!*p || !*q) - return make_fixnum (*p - *q); + + if ((p + ichar_len ('%')) < pend && itext_ichar_eql (p, '%')) + { + if (itext_ichar_eql (p + ichar_len ('%'), '%')) + { + p += ichar_len ('%'); + } + else if (itext_ichar_eql (p + ichar_len ('%'), '_')) + { + p += ichar_len ('%'); + p += ichar_len ('_'); + } + } + + if (p == pend) + { + return make_fixnum (- itext_ichar (q)); + } + + if ((q + ichar_len ('%')) < qend && itext_ichar_eql (q, '%')) + { + if (itext_ichar_eql (q + ichar_len ('%'), '%')) + { + q += ichar_len ('%'); + } + else if (itext_ichar_eql (q + ichar_len ('%'), '_')) + { + q += ichar_len ('%'); + q += ichar_len ('_'); + } + } + + if (q == qend) + { + return make_fixnum (itext_ichar (p)); + } + val = DOWNCASE (0, itext_ichar (p)) - DOWNCASE (0, itext_ichar (q)); if (val) return make_fixnum (val); diff -r 79bef0ac9919 -r e26b605e4e9c tests/ChangeLog --- a/tests/ChangeLog Thu Jul 05 08:12:49 2018 +0100 +++ b/tests/ChangeLog Thu Jul 05 09:03:26 2018 +0100 ＠＠ -1,5 +1,8 ＠＠ 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + * automated/lisp-tests.el (featurep): + Basic tests of compare-menu-text. + * automated/extent-tests.el: #'normalize-menu-text is now available even on builds without the menubar feature, test it even then. diff -r 79bef0ac9919 -r e26b605e4e9c tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Thu Jul 05 08:12:49 2018 +0100 +++ b/tests/automated/lisp-tests.el Thu Jul 05 09:03:26 2018 +0100 ＠＠ -4396,4 +4396,20 ＠＠ (Assert (not (true-list-p []))) (Assert (not (true-list-p -1))) +;;----------------------------------------------------- +;; Testing compare-menu-text +;;----------------------------------------------------- + +(when (featurep 'menubar) + (Assert (eql 0 (compare-menu-text "a" "a"))) + (Assert (eql 0 (compare-menu-text "%_a" "a"))) + (Assert (eql 0 (compare-menu-text "a%" "a%%"))) + (Assert (eql (- ?b ?a) (compare-menu-text "b" "a"))) + (Assert (eql (- ?a ?b) (compare-menu-text "a" "b"))) + ;; This used to give zero, since the function assumed a zero char was the + ;; end of the string as in C. + (Assert (eql (- ?b) (compare-menu-text "a\000" "a\000bcdef")))) + +;; See extent-tests.el for normalize-menu-text, checked in passing. + ;;; end of lisp-tests.el -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Move #'normalize-menu-text to Lisp, given calls on non-menubar builds 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530774769 -3600 # Thu Jul 05 08:12:49 2018 +0100 # Node ID 79bef0ac9919c5b37620c5dc80a75d1a8bf64b00 # Parent 518dac37640275f3d01a24e41d1ac1880e47be9c Move #'normalize-menu-text to Lisp, given calls on non-menubar builds lisp/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * map-ynp.el (normalize-menu-text): Add an autoload for this function, now it's available in Lisp when C menubar support isn't available. * menubar.el (normalize-menu-text): Implement this function, moved from C. src/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> * menubar.c: * menubar.c (vars_of_menubar): Move #'normalize-menu-text to Lisp, it's not called much and the occasional use of the function in builds without C menubar support is much more practical with it in Lisp. diff -r 518dac376402 -r 79bef0ac9919 lisp/ChangeLog --- a/lisp/ChangeLog Wed Jul 04 18:35:31 2018 +0100 +++ b/lisp/ChangeLog Thu Jul 05 08:12:49 2018 +0100 ＠＠ -1,3 +1,11 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * map-ynp.el (normalize-menu-text): Add an autoload for this + function, now it's available in Lisp when C menubar support isn't + available. + * menubar.el (normalize-menu-text): Implement this function, moved + from C. + 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> * loadup.el (source-lisp): diff -r 518dac376402 -r 79bef0ac9919 lisp/map-ynp.el --- a/lisp/map-ynp.el Wed Jul 04 18:35:31 2018 +0100 +++ b/lisp/map-ynp.el Thu Jul 05 08:12:49 2018 +0100 ＠＠ -36,6 +36,10 ＠＠ ;;; Code: +;; We use normalize-menu-text even if the menubar files aren't dumped. Make +;; sure XEmacs knows where to find it: +(autoload 'normalize-menu-text "menubar") + (defun map-y-or-n-p (prompter actor list &optional help action-alist no-cursor-in-echo-area) "Ask a series of boolean questions. diff -r 518dac376402 -r 79bef0ac9919 lisp/menubar.el --- a/lisp/menubar.el Wed Jul 04 18:35:31 2018 +0100 +++ b/lisp/menubar.el Thu Jul 05 08:12:49 2018 +0100 ＠＠ -164,6 +164,38 ＠＠ ;;; basic menu manipulation functions +(defun normalize-menu-text (name) + "Convert NAME, a menu string, into menu normal form. + +Menu item names should be converted to normal form before being compared. +This removes %_'s (accelerator indications) and converts %% to %. The +returned string may be the same string as the original. + +See `compare-menu-text', which does this comparison without creating new +strings, and so is free in terms of garbage-collection." + (let (stream (position 0) (last 0) (length (length name))) + (while (setq position (position ?% name :start position)) + (incf position) + (when (< position length) + (cond + ((eql ?% (aref name position)) + (write-sequence name (or stream + (setq stream (make-string-output-stream))) + :start last :end position) + (setq last (1+ position) + position last)) + ((eql ?_ (aref name position)) + (write-sequence name (or stream + (setq stream (make-string-output-stream))) + :start last :end (1- position)) + (setq last (1+ position) + position last)) + (t (incf position))))) + (if (not stream) + name + (write-sequence name stream :start last) + (get-output-stream-string stream)))) + (defun menu-item-text (item &optional normalize) "Return the text that is displayed for a menu item. If ITEM is a string (unselectable text), it is returned; otherwise, ＠＠ -885,7 +917,4 ＠＠ (define-key menu-accelerator-map [kp-enter] 'menu-select) (define-key menu-accelerator-map "\C-g" 'menu-quit))) - -(provide 'menubar) - ;;; menubar.el ends here diff -r 518dac376402 -r 79bef0ac9919 src/ChangeLog --- a/src/ChangeLog Wed Jul 04 18:35:31 2018 +0100 +++ b/src/ChangeLog Thu Jul 05 08:12:49 2018 +0100 ＠＠ -1,3 +1,11 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * menubar.c: + * menubar.c (vars_of_menubar): + Move #'normalize-menu-text to Lisp, it's not called much and the + occasional use of the function in builds without C menubar support + is much more practical with it in Lisp. + 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> * eval.c (Fdefmacro): diff -r 518dac376402 -r 79bef0ac9919 src/menubar.c --- a/src/menubar.c Wed Jul 04 18:35:31 2018 +0100 +++ b/src/menubar.c Thu Jul 05 08:12:49 2018 +0100 ＠＠ -41,6 +41,7 ＠＠ #include "specifier.h" #include "window-impl.h" #include "lstream.h" +#include "text.h" int menubar_show_keybindings; Lisp_Object Vmenubar_configuration; ＠＠ -362,94 +363,6 ＠＠ } } -DEFUN ("normalize-menu-text", Fnormalize_menu_text, 1, 1, 0, /* -Convert a menu item name string into normal form, and return the new string. -Menu item names should be converted to normal form before being compared. -This removes %_'s (accelerator indications) and converts %% to %. -The returned string may be the same string as the original. -*/ - (name)) -{ - const Ibyte *name_data, *pend, *lastp; - Lisp_Object stream = Qnil; - - CHECK_STRING (name); - - name_data = lastp = XSTRING_DATA (name); - pend = name_data + XSTRING_LENGTH (name); - - while (name_data < pend) - { - name_data = (const Ibyte *) memchr (name_data, '%', pend - name_data); - - if (!name_data) - { - break; - } - - name_data += ichar_len ('%'); - - if (name_data >= pend) - { - break; - } - - if (itext_ichar_eql (name_data, '%')) - { - /* Allow `%%' to mean `%'. */ - if (NILP (stream)) - { - /* Writing to this cannot GC. */ - stream = make_resizing_buffer_output_stream (); - } - - Lstream_write_with_extents (XLSTREAM (stream), name, - lastp - XSTRING_DATA (name), - name_data - lastp); - - name_data += ichar_len ('%'); - lastp = name_data; - } - else if (itext_ichar_eql (name_data, '_')) - { - if (NILP (stream)) - { - stream = make_resizing_buffer_output_stream (); - } - - Lstream_write_with_extents (XLSTREAM (stream), name, - lastp - XSTRING_DATA (name), - name_data - lastp - - ichar_len ('%')); - - name_data += ichar_len ('_'); - lastp = name_data; - } - else - { - INC_IBYTEPTR (name_data); - INC_IBYTEPTR (name_data); - /* No need to modify LASTP. */ - } - } - - if (NILP (stream)) - { - /* No %_ or %% encountered. */ - return name; - } - - if (lastp < pend) - { - Lstream_write_with_extents (XLSTREAM (stream), name, - lastp - XSTRING_DATA (name), pend - lastp); - } - - name = resizing_buffer_to_lisp_string (XLSTREAM (stream)); - Lstream_delete (XLSTREAM (stream)); - return name; -} - void syms_of_menubar (void) { ＠＠ -468,7 +381,6 ＠＠ DEFSUBR (Fpopup_menu); DEFSUBR (Fcompare_menu_text); - DEFSUBR (Fnormalize_menu_text); DEFSUBR (Fmenu_find_real_submenu); } diff -r 518dac376402 -r 79bef0ac9919 tests/ChangeLog --- a/tests/ChangeLog Wed Jul 04 18:35:31 2018 +0100 +++ b/tests/ChangeLog Thu Jul 05 08:12:49 2018 +0100 ＠＠ -1,3 +1,9 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * automated/extent-tests.el: + #'normalize-menu-text is now available even on builds without the + menubar feature, test it even then. + 2018-06-24 Aidan Kehoe <kehoea(a)parhasard.net> * automated/format-tests.el: diff -r 518dac376402 -r 79bef0ac9919 tests/automated/extent-tests.el --- a/tests/automated/extent-tests.el Wed Jul 04 18:35:31 2018 +0100 +++ b/tests/automated/extent-tests.el Thu Jul 05 08:12:49 2018 +0100 ＠＠ -674,23 +674,22 ＠＠ "ME\xc4\xb0NE"))) (set-language-environment env)))) - (when (featurep 'menubar) - (Assert - (equal - "So bist du meine Tochter nimmer% mehr!" - (setf normalize - (normalize-menu-text - (mapconcat #'identity - (sublis '(("du" . "d%_u") ("nimmer" . "nimmer%%")) - split :test #'equal) - " "))))) - (Assert (extentp - (setf pE - (car (extent-list normalize nil nil nil property-name)))) - "checking extent copied, \"Tochter\", normalize-menu-text") - (Assert (extentp - (setf pEE - (car (extent-list normalize nil nil nil 'count)))) - "checking extent copied, \"mehr!\""))) + (Assert + (equal + "So bist du meine Tochter nimmer% mehr!" + (setf normalize + (normalize-menu-text + (mapconcat #'identity + (sublis '(("du" . "d%_u") ("nimmer" . "nimmer%%")) + split :test #'equal) + " "))))) + (Assert (extentp + (setf pE + (car (extent-list normalize nil nil nil property-name)))) + "checking extent copied, \"Tochter\", normalize-menu-text") + (Assert (extentp + (setf pEE + (car (extent-list normalize nil nil nil 'count)))) + "checking extent copied, \"mehr!\"")) ;;; end of extent-tests.el -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] No need to have #'nth, #'identity in C either, move them to subr.el 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530725731 -3600 # Wed Jul 04 18:35:31 2018 +0100 # Node ID 518dac37640275f3d01a24e41d1ac1880e47be9c # Parent 73b61c5225a6c7026ea8a8a40372a97160f53202 No need to have #'nth, #'identity in C either, move them to subr.el src/ChangeLog addition: 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> * eval.c (Fdefmacro): Fnth() no longer available, use its implementation. * fns.c (Fnth, Fidentity): Move to subr.el. * fns.c (syms_of_fns): Remove their DEFSUBR()s from here. * lisp.h: Remove Fnth()'s declaration from here. * select.c (get_selection_raw_time): Fnth not available, use its implementation. lisp/ChangeLog addition: 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> * loadup.el (source-lisp): * make-docfile.el (source-lisp): * update-elc.el (source-lisp): #'nth no longer available on a bare-metal XEmacs, use its implementation. * subr.el: * subr.el (identity): New. * subr.el (nth): New. Move these functions here from fns.c. diff -r 73b61c5225a6 -r 518dac376402 lisp/ChangeLog --- a/lisp/ChangeLog Wed Jul 04 18:29:08 2018 +0100 +++ b/lisp/ChangeLog Wed Jul 04 18:35:31 2018 +0100 ＠＠ -1,3 +1,15 ＠＠ +2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * loadup.el (source-lisp): + * make-docfile.el (source-lisp): + * update-elc.el (source-lisp): + #'nth no longer available on a bare-metal XEmacs, use its + implementation. + * subr.el: + * subr.el (identity): New. + * subr.el (nth): New. + Move these functions here from fns.c. + 2018-07-01 Aidan Kehoe <kehoea(a)parhasard.net> * bytecomp.el (byte-compile-normal-call): diff -r 73b61c5225a6 -r 518dac376402 lisp/loadup.el --- a/lisp/loadup.el Wed Jul 04 18:29:08 2018 +0100 +++ b/lisp/loadup.el Wed Jul 04 18:35:31 2018 +0100 ＠＠ -62,7 +62,7 ＠＠ ;; Can't make this constant for now because it causes an error in ;; update-elc.el. -(defvar source-lisp (file-name-directory (expand-file-name (nth 2 command-line-args))) "\ +(defvar source-lisp (file-name-directory (expand-file-name (car (nthcdr 2 command-line-args)))) "\ Root of tree containing the Lisp source code for the current build. Differs from `lisp-directory' if this XEmacs has been installed. ") diff -r 73b61c5225a6 -r 518dac376402 lisp/make-docfile.el --- a/lisp/make-docfile.el Wed Jul 04 18:29:08 2018 +0100 +++ b/lisp/make-docfile.el Wed Jul 04 18:35:31 2018 +0100 ＠＠ -46,7 +46,7 ＠＠ (defvar build-directory (expand-file-name ".." invocation-directory)) (defvar build-lib-src (expand-file-name "lib-src" build-directory)) (defvar source-lisp (file-name-directory (expand-file-name - (nth 2 command-line-args)))) + (car (nthcdr 2 command-line-args))))) (defvar source-src (expand-file-name "../src" source-lisp)) (defun message (fmt &rest args) diff -r 73b61c5225a6 -r 518dac376402 lisp/subr.el --- a/lisp/subr.el Wed Jul 04 18:29:08 2018 +0100 +++ b/lisp/subr.el Wed Jul 04 18:35:31 2018 +0100 ＠＠ -371,6 +371,16 ＠＠ (setq hare (cdr hare) length (1+ length))) length)) + +;; Some more, this time from fns.c +(defun identity (arg) + "Return the argument unchanged." + arg) + +(defun nth (n list) + "Return the Nth element of LIST. +N counts from zero. If LIST is not that long, nil is returned." + (car (nthcdr n list))) ;;;; Keymap support. ;; XEmacs: removed to keymap.el diff -r 73b61c5225a6 -r 518dac376402 lisp/update-elc.el --- a/lisp/update-elc.el Wed Jul 04 18:29:08 2018 +0100 +++ b/lisp/update-elc.el Wed Jul 04 18:35:31 2018 +0100 ＠＠ -80,7 +80,7 ＠＠ (defvar build-directory (expand-file-name ".." invocation-directory)) (defvar source-lisp (file-name-directory (expand-file-name - (nth 2 command-line-args)))) + (car (nthcdr 2 command-line-args))))) (defvar source-lisp-mule (expand-file-name "mule" source-lisp)) (defvar source-directory (expand-file-name ".." source-lisp)) diff -r 73b61c5225a6 -r 518dac376402 src/ChangeLog --- a/src/ChangeLog Wed Jul 04 18:29:08 2018 +0100 +++ b/src/ChangeLog Wed Jul 04 18:35:31 2018 +0100 ＠＠ -1,3 +1,13 ＠＠ +2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * eval.c (Fdefmacro): + Fnth() no longer available, use its implementation. + * fns.c (Fnth, Fidentity): Move to subr.el. + * fns.c (syms_of_fns): Remove their DEFSUBR()s from here. + * lisp.h: Remove Fnth()'s declaration from here. + * select.c (get_selection_raw_time): + Fnth not available, use its implementation. + 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> * symbols.c (Fspecial_operator_p): diff -r 73b61c5225a6 -r 518dac376402 src/eval.c --- a/src/eval.c Wed Jul 04 18:29:08 2018 +0100 +++ b/src/eval.c Wed Jul 04 18:35:31 2018 +0100 ＠＠ -1424,7 +1424,7 ＠＠ /* This function can GC */ if (!NILP (Vmacro_declaration_function)) { - Lisp_Object declare = Fnth (make_fixnum (2), args); + Lisp_Object declare = Fcar (Fnthcdr (make_fixnum (2), args)); /* Sigh. This GNU interface is incompatible with the CL declare macro, and the latter is much older. ＠＠ -1440,7 +1440,7 ＠＠ if (STRINGP (declare)) { - declare = Fnth (make_fixnum (3), args); + declare = Fcar (Fnthcdr (make_fixnum (3), args)); } if (CONSP (declare) && EQ (Qdeclare, XCAR (declare))) diff -r 73b61c5225a6 -r 518dac376402 src/fns.c --- a/src/fns.c Wed Jul 04 18:29:08 2018 +0100 +++ b/src/fns.c Wed Jul 04 18:35:31 2018 +0100 ＠＠ -60,14 +60,6 ＠＠ Lisp_Object Vpath_separator; -DEFUN ("identity", Fidentity, 1, 1, 0, /* -Return the argument unchanged. -*/ - (arg)) -{ - return arg; -} - DEFUN ("random", Frandom, 0, 1, 0, /* Return a pseudo-random number. All fixnums are equally likely. On most systems, this is 31 bits' worth. ＠＠ -629,16 +621,6 ＠＠ return tail; } -DEFUN ("nth", Fnth, 2, 2, 0, /* -Return the Nth element of LIST. -N counts from zero. If LIST is not that long, nil is returned. -*/ - (n, list)) -{ - /* This function can GC */ - return Fcar (Fnthcdr (n, list)); -} - DEFUN ("last", Flast, 1, 2, 0, /* Return the tail of list LIST, of length N (default 1). LIST may be a dotted list, but not a circular list. ＠＠ -2971,7 +2953,6 ＠＠ DEFERROR_STANDARD (Qbase64_conversion_error, Qconversion_error); - DEFSUBR (Fidentity); DEFSUBR (Frandom); DEFSUBR (Flist_length); DEFSUBR (Fstring_equal); ＠＠ -2981,7 +2962,6 ＠＠ DEFSUBR (Fcopy_sequence); DEFSUBR (Fcopy_alist); DEFSUBR (Fnthcdr); - DEFSUBR (Fnth); DEFSUBR (Flast); DEFSUBR (Fbutlast); DEFSUBR (Fnbutlast); diff -r 73b61c5225a6 -r 518dac376402 src/lisp.h --- a/src/lisp.h Wed Jul 04 18:29:08 2018 +0100 +++ b/src/lisp.h Wed Jul 04 18:35:31 2018 +0100 ＠＠ -5455,7 +5455,6 ＠＠ EXFUN (Fnconc, MANY); MODULE_API EXFUN (Fnreverse, 1); EXFUN (Fnthcdr, 2); -EXFUN (Fnth, 2); EXFUN (Fold_assq, 2); EXFUN (Fold_equal, 2); EXFUN (Fold_member, 2); diff -r 73b61c5225a6 -r 518dac376402 src/select.c --- a/src/select.c Wed Jul 04 18:29:08 2018 +0100 +++ b/src/select.c Wed Jul 04 18:35:31 2018 +0100 ＠＠ -463,7 +463,7 ＠＠ { Lisp_Object local_value = assq_no_quit (selection, Vselection_alist); - return Fnth (make_fixnum (2), local_value); + return Fcar (Fnthcdr (make_fixnum (2), local_value)); } /* Get the timestamp of the given selection */ -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Make the docstring to #'special-operator-p a little more helpful. 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530725348 -3600 # Wed Jul 04 18:29:08 2018 +0100 # Node ID 73b61c5225a6c7026ea8a8a40372a97160f53202 # Parent 7fb73e4efef3a3629eaf1b4253d47751e65894fa Make the docstring to #'special-operator-p a little more helpful. src/ChangeLog addition: 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> * symbols.c (Fspecial_operator_p): Change the name of the argument of this function to OBJECT in its docstring, to make it clearer that there is no error if the argument is a non-subr. diff -r 7fb73e4efef3 -r 73b61c5225a6 src/ChangeLog --- a/src/ChangeLog Sun Jul 01 21:06:56 2018 +0100 +++ b/src/ChangeLog Wed Jul 04 18:29:08 2018 +0100 ＠＠ -1,3 +1,10 ＠＠ +2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net> + + * symbols.c (Fspecial_operator_p): + Change the name of the argument of this function to OBJECT in its + docstring, to make it clearer that there is no error if the + argument is a non-subr. + 2018-06-30 Aidan Kehoe <kehoea(a)parhasard.net> * glyphs.c (check_window_subwindow_cache): diff -r 7fb73e4efef3 -r 73b61c5225a6 src/symbols.c --- a/src/symbols.c Sun Jul 01 21:06:56 2018 +0100 +++ b/src/symbols.c Wed Jul 04 18:29:08 2018 +0100 ＠＠ -444,7 +444,7 ＠＠ } DEFUN ("special-operator-p", Fspecial_operator_p, 1, 1, 0, /* -Return whether SUBR is a special operator. +Return whether OBJECT is a special operator. A special operator is a built-in function (a subr, that is a function implemented in C, not Lisp) which does not necessarily evaluate all its ＠＠ -457,10 +457,10 ＠＠ implementations) way to go about it is to write a macro instead. See `defmacro' and `backquote'. */ - (subr)) + (object)) { - subr = indirect_function (subr, 0); - return (SUBRP (subr) && XSUBR (subr)->max_args == UNEVALLED) ? Qt : Qnil; + object = indirect_function (object, 0); + return (SUBRP (object) && XSUBR (object)->max_args == UNEVALLED) ? Qt : Qnil; } DEFUN ("setplist", Fsetplist, 2, 2, 0, /* -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Remove an unnecessary warning from fontconfig.el by fixing the byte compiler 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530475616 -3600 # Sun Jul 01 21:06:56 2018 +0100 # Node ID 7fb73e4efef3a3629eaf1b4253d47751e65894fa # Parent c27d849506b0836a8c8b9052dbb178048229da2a Remove an unnecessary warning from fontconfig.el by fixing the byte compiler lisp/ChangeLog addition: 2018-07-01 Aidan Kehoe <kehoea(a)parhasard.net> * bytecomp.el (byte-compile-normal-call): When examining the :test, :key, etc arguments, be aware that a quoted symbol may be a data placeholder, and take that into account before warning. [...] diff -r c27d849506b0 -r 7fb73e4efef3 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jul 01 16:32:48 2018 +0100 +++ b/lisp/ChangeLog Sun Jul 01 21:06:56 2018 +0100 ＠＠ -1,5 +1,9 ＠＠ 2018-07-01 Aidan Kehoe <kehoea(a)parhasard.net> + * bytecomp.el (byte-compile-normal-call): + When examining the :test, :key, etc arguments, be aware that a + quoted symbol may be a data placeholder, and take that into + account before warning. * cl-extra.el (cl-macroexpand-all): Only close around variables that are actually *used* in the lambda, when dealing with lambdas and lexical scope. diff -r c27d849506b0 -r 7fb73e4efef3 lisp/bytecomp.el --- a/lisp/bytecomp.el Sun Jul 01 16:32:48 2018 +0100 +++ b/lisp/bytecomp.el Sun Jul 01 21:06:56 2018 +0100 ＠＠ -3165,11 +3165,29 ＠＠ (map nil (function* (lambda ((function . nargs)) - (let ((value (plist-get plist function not-present))) + (let ((value (plist-get plist function not-present)) + list) (when (and (not (eq value not-present)) (byte-compile-constp value)) + (setq value (eval value)) + (when (and (symbolp value) + (get value + 'byte-compile-label-calls) + (not (assq + value + byte-compile-function-environment))) + (setq list byte-compile-function-environment) + (while list + (when (and + (symbolp (caar list)) + (eq value + (get (caar list) + 'byte-compile-data-placeholder))) + (setq value (caar list) + list nil)) + (setq list (cdr list)))) (byte-compile-callargs-warn - (cons (eval value) + (cons value (member* nargs ;; Dummy arguments. There's no need for -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

[COMMIT] Small fixes, #'apply-partially. 6 years, 3 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1530456266 -3600 # Sun Jul 01 15:44:26 2018 +0100 # Node ID 665a83d265d76b1a23285d90efb85191f8766b6f # Parent c66cd0e4e0e01df0a941afa79d9c65498021ddf2 Small fixes, #'apply-partially. lisp/ChangeLog addition: 2018-07-01 Aidan Kehoe <kehoea(a)parhasard.net> [...] * subr.el (apply-partially): [...] Do the check for the number of args passed correctly. If we haven't been supplied an explicit lambda, use an uninterned symbol for the argument list name, avoiding problems with dynamic scope. diff -r c66cd0e4e0e0 -r 665a83d265d7 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jul 01 14:11:26 2018 +0100 +++ b/lisp/ChangeLog Sun Jul 01 15:44:26 2018 +0100 ＠＠ -11,6 +11,10 ＠＠ we've been supplied an explicit lambda. Parse the supplied arglist and construct one that reflects it, something that allows the byte compiler to give more useful warnings with labels. + Do the check for the number of args passed correctly. + If we haven't been supplied an explicit lambda, use an uninterned + symbol for the argument list name, avoiding problems with dynamic + scope. 2018-06-30 Aidan Kehoe <kehoea(a)parhasard.net> diff -r c66cd0e4e0e0 -r 665a83d265d7 lisp/subr.el --- a/lisp/subr.el Sun Jul 01 14:11:26 2018 +0100 +++ b/lisp/subr.el Sun Jul 01 15:44:26 2018 +0100 ＠＠ -83,7 +83,7 ＠＠ the first N arguments are fixed at the values with which this function was called." (if (and (eq 'lambda (car-safe function)) - (< (length args) (or (function-max-args function) + (<= (length args) (or (function-max-args function) most-positive-fixnum))) ;; XEmacs; for our constructed function, don't just use a (&rest args) ;; arglist if there is an explicit lambda supplied. This allows the ＠＠ -125,8 +125,8 ＠＠ (push (pop body) header)) `(lambda ,arglist ,＠(nreverse header) (let ,(nreverse bindings) ,＠body))) - `(lambda (&rest args) - (apply ',function ,＠(mapcar 'quote-maybe args) args)))) + `(lambda (&rest #1=#:args) + (apply ',function ,＠(mapcar 'quote-maybe args) #1#)))) ;; FSF 21.2 has various basic macros here. We don't because they're either ;; in cl*.el (which we dump and hence is always available) or built-in. -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches July 2018