APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1553240516 0 # Fri Mar 22 07:41:56 2019 +0000 # Node ID 8110c5579c84377541e0dc765bea9cec942292f0 # Parent c0ed7ef9a5a17c92a58a62b0b161a6da5714e9dd Move several more non-loop-hotspot functions from C to Lisp. src/ChangeLog addition: 2019-03-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; Move several more functions, not loop hotspots and easily implemented in Lisp, from C to Lisp. * abbrev.c: * abbrev.c (syms_of_abbrev): * abbrev.c (vars_of_abbrev): Move Finsert_abbrev_table_description() to abbrev.el. * bytecode.c (UNUSED): Fend_of_line() no longer in C, use its implementation. * callint.c: * callint.c (Fcall_interactively): * callint.c (syms_of_callint): * callint.c (vars_of_callint): Move Fprefix_numeric_value() to cmdloop.el, call it using its symbol as needed. * cmds.c: * cmds.c (syms_of_cmds): Move Fbackward_char(), Fbeginning_of_line(), Fend_of_line() to simple.el. * data.c (syms_of_data): Move Farrayp(), Fsequencep(), Fnatnump(), Fnonnegativep() to subr.el. * device-x.c (syms_of_device_x): Move Fdefault_x_device() to x-misc.el. * doprnt.c: * doprnt.c (syms_of_doprnt): Move Fformat() to subr.el. * editfns.c: * editfns.c (syms_of_editfns): Move Fchar_equal(), Fstring_to_char(), Fchar_to_string() to subr.el * event-msw.c (mswindows_dde_callback): Call Fformat_into() here, now Fformat() is in Lisp. * fileio.c (Fcopy_file): Call Fstring() here, now Fchar_to_string() is in Lisp. * lisp.h: * lread.c (read0): Call Fstring() here, now Fchar_to_string() is in Lisp. * macros.c (Fend_kbd_macro): * macros.c (Fexecute_kbd_macro): Call #'prefix-numeric-value through its Lisp symbol here, now it's no longer in C. * scrollbar.c (scrollbar_reset_cursor): Fbeginning_of_line() no longer in C, use its implementation. * sunpro.c: Call Fformat_into() here, now Fformat() is in Lisp. * window.c (window_scroll): * window.c (Fscroll_left): * window.c (Fscroll_right): * window.c (Fcenter_to_window_line): * window.c (Fmove_to_window_line): Call #'prefix-numeric-value through its Lisp symbol here, now it's no longer in C. lisp/ChangeLog addition: 2019-03-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; Move several more functions, not loop hotspots and easily implemented in Lisp, from C to Lisp. * abbrev.el: * abbrev.el (insert-abbrev-table-description): New. Move this back to Lisp, now there's a penalty for it being in C with NEWGC. Remove comment with old Lisp implementation. * cmdloop.el: * cmdloop.el (prefix-numeric-value): New. Move this here from callint.c. * loadup.el: * loadup.el (really-early-error-handler): Use #'format-into rather than (princ (format ...)), now #'format is not available on a bare-metal XEmacs. * setup-paths.el (paths-default-info-directories): Use (string directory-sep-char) rather than (char-to-string directory-sep-char), now the latter is not available on a bare-metal XEmacs. * simple.el: * simple.el (backward-char): New. * simple.el (beginning-of-line): New. * simple.el (end-of-line): New. Move these three from cmds.c. * subr.el: * subr.el (format): New. Move this from doprnt.c * subr.el (arrayp): New. * subr.el (sequencep): New. * subr.el (natnump): New. * subr.el (nonnegativep): New. Move all these from data.c * subr.el (identity): Give this a better argument name and docstring. * subr.el (char-to-string): New. * subr.el (string-to-char): New. * subr.el (char-equal): New. Move these three from editfns.c. * x-misc.el: * x-misc.el (default-x-device): New. Move this from device-x.c. diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/ChangeLog --- a/lisp/ChangeLog Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/ChangeLog Fri Mar 22 07:41:56 2019 +0000 ＠＠ -4,6 +4,51 ＠＠ mismatched format strings and arguments. Patch thanks to Tim Landscheidt <tim(a)tim-landscheidt.de&gt;. +2019-03-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Move several more functions, not loop hotspots and easily + implemented in Lisp, from C to Lisp. + + * abbrev.el: + * abbrev.el (insert-abbrev-table-description): New. + Move this back to Lisp, now there's a penalty for it being in C + with NEWGC. + Remove comment with old Lisp implementation. + + * cmdloop.el: + * cmdloop.el (prefix-numeric-value): New. + Move this here from callint.c. + * loadup.el: + * loadup.el (really-early-error-handler): + Use #'format-into rather than (princ (format ...)), now #'format + is not available on a bare-metal XEmacs. + * setup-paths.el (paths-default-info-directories): + Use (string directory-sep-char) rather than (char-to-string + directory-sep-char), now the latter is not available on a + bare-metal XEmacs. + * simple.el: + * simple.el (backward-char): New. + * simple.el (beginning-of-line): New. + * simple.el (end-of-line): New. + Move these three from cmds.c. + * subr.el: + * subr.el (format): New. + Move this from doprnt.c + * subr.el (arrayp): New. + * subr.el (sequencep): New. + * subr.el (natnump): New. + * subr.el (nonnegativep): New. + Move all these from data.c + * subr.el (identity): + Give this a better argument name and docstring. + * subr.el (char-to-string): New. + * subr.el (string-to-char): New. + * subr.el (char-equal): New. + Move these three from editfns.c. + * x-misc.el: + * x-misc.el (default-x-device): New. + Move this from device-x.c. + 2011-03-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecomp.el: diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/abbrev.el --- a/lisp/abbrev.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/abbrev.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -76,6 +76,84 ＠＠ (setq abbrevs-changed t) nil) +(defun* insert-abbrev-table-description (name &optional readable + (stream (current-buffer))) + "Insert before point a full description of abbrev table named NAME. + +NAME is a symbol whose value is an abbrev table. + +If optional 2nd arg READABLE is non-nil, a human-readable description is +inserted. Otherwise the description is an expression, a call to +`define-abbrev-table', which would define the abbrev table NAME exactly as it +is currently defined. + +Optional third argument STREAM is a stream to use instead of the current +buffer. See the documentation of the variable `standard-output'. + +Abbrevs marked as \"system abbrevs\" are normally omitted. However, if +READABLE is non-nil, they are listed." + (labels + ((write-abbrev (symbol) + (let (count system-flag) + (if (fixnump (symbol-plist symbol)) + (setq count (symbol-plist symbol) + system-flag nil) + (setq count (get symbol 'count pi) + system-flag (get symbol 'system-type))) + (if (or (null (symbol-value symbol)) system-flag) + (return-from write-abbrev nil)) + (unless (fixnump count) + (error 'internal-error "odd abbrev table COUNT")) + (write-sequence " (" stream) + (write-sequence (symbol-name symbol) stream) + (write-sequence " " stream) + (prin1 (symbol-value symbol) stream) + (write-sequence " " stream) + (prin1 (symbol-function symbol) stream) + (format-into stream " %d)\n" count))) + (describe-abbrev (symbol) + (let (count system-flag symbol-name) + (if (fixnump (symbol-plist symbol)) + (setq count (symbol-plist symbol) + system-flag nil) + (setq count (get symbol 'count pi) + system-flag (get symbol 'system-type))) + (if (null (symbol-value symbol)) + (return-from describe-abbrev nil)) + (unless (fixnump count) + (error 'internal-error "odd abbrev table COUNT")) + (write-sequence (setq symbol-name (symbol-name symbol)) + stream) + (if system-flag + (format-into stream + " (sys)%*S " (- 19 (length " (sys)") + (length symbol-name)) + count) + (format-into stream " %*S " (- 14 (length symbol-name)) count)) + (prin1 (symbol-value symbol) stream) + (write-sequence " " stream) + (when (and (fboundp symbol) (symbol-function symbol)) + (write-sequence " " stream) + (prin1 (symbol-function symbol) stream)) + (write-sequence "\n" stream)))) + (let ((symbols (sort (hash-table-value-list (symbol-value name)) + #'string-lessp))) + (if readable + (progn + (write-sequence "(" stream) + (prin1 name stream) + (write-sequence ")\n\n" stream) + (mapc #'describe-abbrev symbols) + (write-sequence "\n\n" stream)) + (write-sequence "(define-abbrev-table '" stream) + (prin1 name stream) + (if (null symbols) + (write-sequence " '())\n\n" stream) + (write-sequence " '(\n" stream) + (mapc #'write-abbrev symbols) + (write-sequence " ))\n\n" stream))) + nil))) + (defun define-abbrev-table (table-name definitions) "Define TABLE-NAME (a symbol) as an abbrev table name. Define abbrevs in it according to DEFINITIONS, which is a list of elements ＠＠ -188,67 +266,6 ＠＠ (goto-char (- opoint adjust)) (goto-char opoint))))) - -; APA: Moved to c (ported function from GNU Emacs to src/abbrev.c) -; (defun insert-abbrev-table-description (name &optional human-readable) -; "Insert before point a full description of abbrev table named NAME. -; NAME is a symbol whose value is an abbrev table. -; If optional second argument HUMAN-READABLE is non-nil, insert a -; human-readable description. Otherwise the description is an -; expression, a call to `define-abbrev-table', which would define the -; abbrev table NAME exactly as it is currently defined." -; (let ((table (symbol-value name)) -; (stream (current-buffer))) -; (message "Abbrev-table %s..." name) -; (if human-readable -; (progn -; (prin1 (list name) stream) -; ;; Need two terpri's or cretinous edit-abbrevs blows out -; (terpri stream) -; (terpri stream) -; (mapatoms (function (lambda (sym) -; (if (symbol-value sym) -; (let* ((n (prin1-to-string (symbol-name sym))) -; (pos (length n))) -; (princ n stream) -; (while (< pos 14) -; (write-char ?\ stream) -; (setq pos (1+ pos))) -; (princ (format " %-5S " (symbol-plist sym)) -; stream) -; (if (not (symbol-function sym)) -; (prin1 (symbol-value sym) stream) -; (progn -; (setq n (prin1-to-string (symbol-value sym)) -; pos (+ pos 6 (length n))) -; (princ n stream) -; (while (< pos 45) -; (write-char ?\ stream) -; (setq pos (1+ pos))) -; (prin1 (symbol-function sym) stream))) -; (terpri stream))))) -; table) -; (terpri stream)) -; (progn -; (princ "\(define-abbrev-table '" stream) -; (prin1 name stream) -; (princ " '\(\n" stream) -; (mapatoms (function (lambda (sym) -; (if (symbol-value sym) -; (progn -; (princ " " stream) -; (prin1 (list (symbol-name sym) -; (symbol-value sym) -; (symbol-function sym) -; (symbol-plist sym)) -; stream) -; (terpri stream))))) -; table) -; (princ " \)\)\n" stream))) -; (terpri stream)) -; (message "")) -;;; End code not in FSF - (defun abbrev-mode (arg) "Toggle abbrev mode. With argument ARG, enable abbrev mode if ARG is positive, else disable. diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/cmdloop.el --- a/lisp/cmdloop.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/cmdloop.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -35,6 +35,17 ＠＠ (globally-declare-fboundp (unless (featurep 'dialog) '(yes-or-no-p-dialog-box))) +;; XEmacs; moved here from callint.c +(defun prefix-numeric-value (raw) + "Return numeric meaning of raw prefix argument RAW. +A raw prefix argument is what you get from `(interactive \"P\")'. +Its numeric meaning is what you would get from `(interactive \"p\")'." + (cond ((not raw) 1) + ((eq raw '-) -1) + ((fixnump raw) raw) + ((fixnump (car-safe raw)) (car raw)) + (t 1))) + (defun recursion-depth () "Return the current depth in recursive edits." (+ command-loop-level (minibuffer-depth))) diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/loadup.el --- a/lisp/loadup.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/loadup.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -49,10 +49,10 ＠＠ ;; export XEMACSDEBUG='(setq debug-on-error t)' (setq debug-on-error t)) -;(princ (format "command-line-args: %s\n" command-line-args)) -;(princ (format "configure-lisp-directory: %S\n" configure-lisp-directory)) -;(princ (format "configure-data-directory: %S\n" configure-data-directory)) -;(princ (format "lisp-directory: %S\n" lisp-directory)) +;(format-into 'standard-output "command-line-args: %s\n" command-line-args) +;(format-into 'standard-output "configure-lisp-directory: %S\n" configure-lisp-directory) +;(format-into 'standard-output "configure-data-directory: %S\n" configure-data-directory) +;(format-into 'standard-output "lisp-directory: %S\n" lisp-directory) (when (fboundp 'error) (error "loadup.el already loaded!")) ＠＠ -100,9 +100,10 ＠＠ (expand-file-name "modules" build-directory))) ;; message not defined yet ... - (external-debugging-output (format "\nUsing load-path %s" load-path)) - (external-debugging-output (format "\nUsing module-load-path %s" - module-load-path)) + (format-into 'external-debugging-output "\nUsing load-path %s" + load-path) + (format-into 'external-debugging-output "\nUsing module-load-path %s" + module-load-path) ;; We don't want to have any undo records in the dumped XEmacs. (buffer-disable-undo (get-buffer "*scratch*")) ＠＠ -139,12 +140,12 ＠＠ ;; but garbage collection really slows down loading. (unless (memq 'quick-build internal-error-checking) (garbage-collect))) - (external-debugging-output (format "\nLoad file %s: not found\n" - file)) + (format-into 'external-debugging-output + "\nLoad file %s: not found\n" file) ;; Uncomment in case of trouble - ;;(print (format "late-package-hierarchies: %S" late-package-hierarchies)) - ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p))) - ;;(print (format "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p))) + ;;(format-into 'external-debugging-output "late-package-hierarchies: %S" late-package-hierarchies) + ;;(format-into 'external-debugging-output "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p)) + ;;(format-into 'external-debugging-output "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p)) nil))) (load (expand-file-name "dumped-lisp.el" source-lisp)) diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/setup-paths.el --- a/lisp/setup-paths.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/setup-paths.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -60,7 +60,7 ＠＠ (mapcar (function (lambda (dirlist) (paths-construct-path - dirlist (char-to-string directory-sep-char)))) + dirlist (string directory-sep-char)))) '(("usr" "local" "info") ("usr" "info") ("usr" "local" "share" "info") diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/simple.el --- a/lisp/simple.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/simple.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -2227,6 +2227,22 ＠＠ (beginning-of-buffer nil) (end-of-buffer nil)))) +(defun backward-char (&optional count buffer) + "Move point left COUNT characters (right if COUNT is negative). +On attempt to pass end of buffer, stop and signal `end-of-buffer'. +On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. + +The characters that are moved over may be added to the current selection +\(i.e. active region) if the Shift key is held down, a motion key is used +to invoke this command, and `shifted-motion-keys-select-region' is t; see +the documentation for this variable for more details." + (interactive "_p") + (if (null count) + (setq count -1) + (check-type count fixnum) + (setq count (- count))) + (forward-char count buffer)) + (defun backward-char-command (&optional arg buffer) "Move point left ARG characters (right if ARG negative) in BUFFER. On attempt to pass end of buffer, stop and signal `end-of-buffer'. ＠＠ -2391,6 +2407,34 ＠＠ (line-move (- count))) nil) +(defun beginning-of-line (&optional count buffer) + "Move point to beginning of current line. +With argument COUNT not nil or 1, move forward COUNT - 1 lines first. +If scan reaches end of buffer, stop there without error. +If BUFFER is nil, the current buffer is assumed. + +The characters that are moved over may be added to the current selection +\(i.e. active region) if the Shift key is held down, a motion key is used +to invoke this command, and `shifted-motion-keys-select-region' is t; see +the documentation for this variable for more details." + (interactive "_p") + (goto-char (point-at-bol count buffer) buffer) + nil) + +(defun end-of-line (&optional count buffer) + "Move point to end of current line. +With argument COUNT not nil or 1, move forward COUNT - 1 lines first. +If scan reaches end of buffer, stop there without error. +If BUFFER is nil, the current buffer is assumed. + +The characters that are moved over may be added to the current selection +\(i.e. active region) if the Shift key is held down, a motion key is used +to invoke this command, and `shifted-motion-keys-select-region' is t; see +the documentation for this variable for more details." + (interactive "_p") + (goto-char (point-at-eol count buffer) buffer) + nil) + (defcustom block-movement-size 6 "*Number of lines that \"block movement\" commands (\\[forward-block-of-lines], \\[backward-block-of-lines]) move by." :type 'integer diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/subr.el --- a/lisp/subr.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/subr.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -169,6 +169,118 ＠＠ (define-function ,＠args)))  +(defun format (&optional control-string &rest arguments) + "Format a string out of CONTROL-STRING and ARGUMENTS. + +The first argument is a control string. +The other arguments are substituted into it to make the result, a string. +It may contain %-sequences meaning to substitute the next argument. +%s means print all objects as-is, using `princ'. +%S means print all objects as s-expressions, using `prin1'. +%d or %i means print as a signed integer in decimal (%o octal, %x lowercase + hex, %X uppercase hex, %b binary). + +%c means print as a single character. +%f means print as a floating-point number in fixed notation (e.g. 785.200). +%e or %E means print as a floating-point number in scientific notation + (e.g. 7.85200e+03). +%g or %G means print as a floating-point number in \"pretty format\"; + depending on the number, either %f or %e/%E format will be used, and + trailing zeroes are removed from the fractional part. +The argument used for all but %s, %S, and %c must be a number. It will be + converted to an integer or a floating-point number as necessary. In + addition, the integer %-sequences accept character arguments as equivalent + to the corresponding fixnums (see `char-int'), while the floating point + sequences do not. + +%$ means reposition to read a specific numbered argument; for example, + %3$s would apply the `%s' to the third argument after the control string, + and the next format directive would use the fourth argument, the + following one the fifth argument, etc. (There must be a positive integer + between the % and the $). + +Zero or more of the flag characters `-', `+', ` ', `0', `!', '&', `~' and `#' + may be specified between the optional repositioning spec and the conversion + character; see below. + +An optional minimum field width may be specified after any flag characters + and before the conversion character; it specifies the minimum number of + characters that the converted argument will take up. Padding will be + added on the left (or on the right, if the `-' flag is specified), as + necessary. Padding is with zeroes if the `0' flag is specified, with the + character specified following the `!' flag if that is supplied (see below), + or by default with spaces. + +If the field width is specified as `*', the field width is assumed to have + been specified as an argument. Any repositioning specification that + would normally specify the argument to be converted will now specify + where to find this field width argument, not where to find the argument + to be converted. If there is no repositioning specification, the normal + next argument is used. The argument to be converted will be the next + argument after the field width argument unless the precision is also + specified as `*' (see below). + +An optional period character and precision may be specified after any + minimum field width. It specifies the minimum number of digits to + appear in %d, %i, %o, %x, and %X conversions (the number is padded + on the left with zeroes as necessary); the number of digits printed + after the decimal point for %f, %e, and %E conversions; the number + of significant digits printed in %g and %G conversions; and the + maximum number of non-padding characters printed in %s and %S + conversions. The default precision for floating-point conversions + is six. Using a precision with %c is an error. +If the precision is specified as `*', the precision is assumed to have been + specified as an argument. The argument used will be the next argument + after the field width argument, if any. If the field width was not + specified as an argument, any repositioning specification that would + normally specify the argument to be converted will now specify where to + find the precision argument. If there is no repositioning specification, + the normal next argument is used. + +An optional length modifier may be specified after any minimum field width or + precision. The length modifiers available are `hh', `h', `l' (ell), `ll' + \(ell-ell). These mean that a following integer conversion character will + print an integer truncated to eight, sixteen, thirty-two, or sixty-four + bits, respectively. Note that this contrasts with ANSI C, where the bit + length depends on the machine choices for the bit width of various integer + types. + +An optional unsigned modifier, the character `u', may be specified after any + length modifier and before an integer conversion character. This specifies + that the following integer conversion is to treat its argument as unsigned. + If no length modifier is specified, this simply means that `format' will + error if the corresponding integer is negative. With a length modifier + `format' will print a positive integer reflecting the twos' complement + representation of the argument in the given number of bits. E.g. `(format + \"%hux\" -1)' will return the string \"ffff\". If no integer conversion + character follows `u', the specification is regarded as equivalent to `ud', + and the argument will be printed in decimal. + +The ` ' and `+' flags mean prefix non-negative numbers with a space or + plus sign, respectively. +The `#' flag means print numbers in an alternate, more verbose format: + octal numbers begin with zero; hex numbers begin with a 0x or 0X; + a decimal point is printed in %f, %e, and %E conversions even if no + numbers are printed after it; and trailing zeroes are not omitted in + %g and %G conversions. +The `&' flag is analogous to the `#' flag for rationals, but the syntax used + to print numbers is that of Common Lisp, rather than C, so octal numbers are + preceded by `#o', binary numbers by `#b' and hexadecimal numbers by `#X' or + `#x' depending on the particular converter character specified. +The `!' flag is followed by a single character, to be used as a pad character + instead of space. It does not override the zero flag. +The `~' flag, when combined with `&' or `#', means to place any sign before + the radix specifier. + +Use %% to put a single % into the output. + +Extent information in CONTROL-STRING and in ARGS is carried over into the +output, in the same way as `concatenate'. Any text created by a character or +numeric %-sequence inherits the extents of the text around it, or of the text +abutting it if those extents' `start-open' and `end-open' properties have the +appropriate values." + (apply #'format-into 'string control-string arguments)) + (defun delete (item sequence) "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. ＠＠ -304,6 +416,22 ＠＠ "Return t if OBJECT is not a list. `nil' is a list." (not (or (consp object) (eq object nil)))) +(defun arrayp (object) + "Return t if OBJECT is an array (string, vector, or bit vector)." + (or (stringp object) (vectorp object) (bit-vector-p object))) + +(defun sequencep (object) + "Return t if OBJECT is a sequence (list or array)." + (or (stringp object) (listp object) (vectorp object) (bit-vector-p object))) + +(defun natnump (object) + "Return t if OBJECT is a nonnegative integer." + (and (integerp object) (not (eql (signum object) -1)))) + +(defun nonnegativep (object) + "Return t if OBJECT is a nonnegative rational." + (and (rationalp object) (not (eql (signum object) -1)))) + (defun bitp (object) "Return t if OBJECT is a bit (0 or 1)." (or (eql object 0) (eql object 1))) ＠＠ -372,10 +500,9 ＠＠ length (1+ length))) length)) -;; Some more, this time from fns.c -(defun identity (arg) - "Return the argument unchanged." - arg) +(defun identity (argument) + "Return ARGUMENT unchanged." + argument) (defun nth (n list) "Return the Nth element of LIST. ＠＠ -1970,4 +2097,26 ＠＠ (/ (car specified-time) 1000000.0)) 0.0))) +(defun char-to-string (character) + "Convert CHARACTER to a one-character string containing that character." + (when (eventp character) + (let ((event-to-character (event-to-character character t))) + (setq character + (or event-to-character (error 'no-character-typed character))))) + (string character)) + +(defun string-to-char (string) + "Convert arg STRING to a character, the first character of that string. +An empty string will return the constant `nil'." + (check-type string string) + (unless (eql (length string) 0) (aref string 0))) + +(defun char-equal (character1 character2 &optional buffer) + "Return t if two characters match, optionally ignoring case. +Both arguments must be characters (i.e. NOT integers). +Case is ignored if `case-fold-search' is non-nil in BUFFER. +If BUFFER is nil, the current buffer is assumed." + (or (eql character1 character2) + (eql (canoncase character1 buffer) (canoncase character2 buffer)))) + ;;; subr.el ends here diff -r c0ed7ef9a5a1 -r 8110c5579c84 lisp/x-misc.el --- a/lisp/x-misc.el Sat Mar 23 18:03:32 2019 -0600 +++ b/lisp/x-misc.el Fri Mar 22 07:41:56 2019 +0000 ＠＠ -90,4 +90,10 ＠＠ DEVICE defaults to the selected device." (and (eq 'x (device-type device)) (device-connection device))) +(defun default-x-device () + "Return the default X device for resourcing. +This is the first-created X device that still exists. +See also `default-device'." + (default-device 'x)) + ;;; x-misc.el ends here diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/ChangeLog --- a/src/ChangeLog Sat Mar 23 18:03:32 2019 -0600 +++ b/src/ChangeLog Fri Mar 22 07:41:56 2019 +0000 ＠＠ -14,6 +14,61 ＠＠ * redisplay.c (redisplay_window): add a missing XFIXNUM. +2019-03-21 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Move several more functions, not loop hotspots and easily + implemented in Lisp, from C to Lisp. + + * abbrev.c: + * abbrev.c (syms_of_abbrev): + * abbrev.c (vars_of_abbrev): + Move Finsert_abbrev_table_description() to abbrev.el. + * bytecode.c (UNUSED): + Fend_of_line() no longer in C, use its implementation. + * callint.c: + * callint.c (Fcall_interactively): + * callint.c (syms_of_callint): + * callint.c (vars_of_callint): + Move Fprefix_numeric_value() to cmdloop.el, call it using its + symbol as needed. + * cmds.c: + * cmds.c (syms_of_cmds): + Move Fbackward_char(), Fbeginning_of_line(), Fend_of_line() to + simple.el. + * data.c (syms_of_data): + Move Farrayp(), Fsequencep(), Fnatnump(), Fnonnegativep() to + subr.el. + * device-x.c (syms_of_device_x): + Move Fdefault_x_device() to x-misc.el. + * doprnt.c: + * doprnt.c (syms_of_doprnt): + Move Fformat() to subr.el. + * editfns.c: + * editfns.c (syms_of_editfns): + Move Fchar_equal(), Fstring_to_char(), Fchar_to_string() to subr.el + * event-msw.c (mswindows_dde_callback): + Call Fformat_into() here, now Fformat() is in Lisp. + * fileio.c (Fcopy_file): + Call Fstring() here, now Fchar_to_string() is in Lisp. + * lisp.h: + * lread.c (read0): + Call Fstring() here, now Fchar_to_string() is in Lisp. + * macros.c (Fend_kbd_macro): + * macros.c (Fexecute_kbd_macro): + Call #'prefix-numeric-value through its Lisp symbol here, now it's + no longer in C. + * scrollbar.c (scrollbar_reset_cursor): + Fbeginning_of_line() no longer in C, use its implementation. + * sunpro.c: + Call Fformat_into() here, now Fformat() is in Lisp. + * window.c (window_scroll): + * window.c (Fscroll_left): + * window.c (Fscroll_right): + * window.c (Fcenter_to_window_line): + * window.c (Fmove_to_window_line): + Call #'prefix-numeric-value through its Lisp symbol here, now it's + no longer in C. + 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net&gt; Mechanically change byte_marker_position() to diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/abbrev.c --- a/src/abbrev.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/abbrev.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -405,153 +405,6 ＠＠ return Vlast_abbrev; } -static void -write_abbrev (Lisp_Object sym, Lisp_Object stream) -{ - Lisp_Object name, count, system_flag; - /* This function can GC */ - struct buffer *buf = current_buffer; - - if (FIXNUMP (XSYMBOL (sym)->plist)) - { - count = XSYMBOL (sym)->plist; - system_flag = Qnil; - } - else - { - count = Fget (sym, Qcount, Qunbound); - system_flag = Fget (sym, Qsystem_type, Qunbound); - } - - if (NILP (XSYMBOL_VALUE (sym)) || ! NILP (system_flag)) - return; - - buffer_insert_ascstring (buf, " ("); - name = Fsymbol_name (sym); - Fprin1 (name, stream); - buffer_insert_ascstring (buf, " "); - Fprin1 (XSYMBOL_VALUE (sym), stream); - buffer_insert_ascstring (buf, " "); - Fprin1 (XSYMBOL (sym)->function, stream); - buffer_insert_ascstring (buf, " "); - Fprin1 (count, stream); - buffer_insert_ascstring (buf, ")\n"); -} - -static void -describe_abbrev (Lisp_Object sym, Lisp_Object stream) -{ - Lisp_Object count, system_flag; - /* This function can GC */ - struct buffer *buf = current_buffer; - - if (FIXNUMP (XSYMBOL (sym)->plist)) - { - count = XSYMBOL (sym)->plist; - system_flag = Qnil; - } - else - { - count = Fget (sym, Qcount, Qunbound); - system_flag = Fget (sym, Qsystem_type, Qunbound); - } - - if (NILP (XSYMBOL_VALUE (sym))) - return; - - Fprin1 (Fsymbol_name (sym), stream); - - if (!NILP (system_flag)) - { - buffer_insert_ascstring (buf, " (sys)"); - Findent_to (make_fixnum (20), Qone, Qnil); - } - else - Findent_to (make_fixnum (15), Qone, Qnil); - - Fprin1 (count, stream); - Findent_to (make_fixnum (20), Qone, Qnil); - - Fprin1 (XSYMBOL_VALUE (sym), stream); - if (!NILP (XSYMBOL (sym)->function)) - { - Findent_to (make_fixnum (45), Qone, Qnil); - Fprin1 (XSYMBOL (sym)->function, stream); - } - buffer_insert_ascstring (buf, "\n"); -} - -static int -record_symbol (Lisp_Object UNUSED (key), Lisp_Object sym, void *arg) -{ - Lisp_Object closure = * (Lisp_Object *) arg; - XSETCDR (closure, Fcons (sym, XCDR (closure))); - return 0; /* Never stop */ -} - -DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, - 1, 2, 0, /* -Insert before point a full description of abbrev table named NAME. -NAME is a symbol whose value is an abbrev table. -If optional 2nd arg READABLE is non-nil, a human-readable description -is inserted. Otherwise the description is an expression, -a call to `define-abbrev-table', which would -define the abbrev table NAME exactly as it is currently defined. - -Abbrevs marked as "system abbrevs" are normally omitted. However, if -READABLE is non-nil, they are listed. */ - (name, readable)) -{ - Lisp_Object table; - Lisp_Object symbols; - Lisp_Object stream; - /* This function can GC */ - struct buffer *buf = current_buffer; - - CHECK_SYMBOL (name); - table = Fsymbol_value (name); - CHECK_HASH_TABLE (table); - - /* FIXME: what's the XEmacs equivalent? APA */ - /* XSETBUFFER (stream, current_buffer); */ - /* Does not seem to work: */ - /* Fset_buffer (stream); */ - stream = wrap_buffer (current_buffer); - - symbols = Fcons (Qnil, Qnil); - elisp_maphash_unsafe (record_symbol, table, &symbols); - - symbols = XCDR (symbols); - symbols = list_sort (symbols, check_string_lessp_nokey, Qnil, Qnil); - - if (!NILP (readable)) - { - buffer_insert_ascstring (buf, "("); - Fprin1 (name, stream); - buffer_insert_ascstring (buf, ")\n\n"); - while (! NILP (symbols)) - { - describe_abbrev (XCAR (symbols), stream); - symbols = XCDR (symbols); - } - - buffer_insert_ascstring (buf, "\n\n"); - } - else - { - buffer_insert_ascstring (buf, "(define-abbrev-table '"); - Fprin1 (name, stream); - buffer_insert_ascstring (buf, " '(\n"); - while (! NILP (symbols)) - { - write_abbrev (XCAR (symbols), stream); - symbols = XCDR (symbols); - } - buffer_insert_ascstring (buf, " ))\n\n"); - } - - return Qnil; -}  void syms_of_abbrev (void) ＠＠ -560,7 +413,6 ＠＠ Qsystem_type = intern ("system-type"); DEFSYMBOL (Qpre_abbrev_expand_hook); DEFSUBR (Fexpand_abbrev); - DEFSUBR (Finsert_abbrev_table_description); } void diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/bytecode.c --- a/src/bytecode.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/bytecode.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -1853,7 +1853,8 ＠＠ } case Bend_of_line: - TOP_LVALUE = Fend_of_line (TOP, Qnil); + Fgoto_char (Fpoint_at_eol (TOP, Qnil), Qnil); + TOP_LVALUE = Qnil; break; case Btemp_output_buffer_setup: diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/callint.c --- a/src/callint.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/callint.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -59,6 +59,7 ＠＠ Lisp_Object QletX, Qsave_excursion; +Lisp_Object Qprefix_numeric_value; Lisp_Object Qread_from_minibuffer; Lisp_Object Qread_file_name; Lisp_Object Qread_directory_name; ＠＠ -820,7 +821,7 ＠＠ { prefix_value: { - Lisp_Object tem = Fprefix_numeric_value (prefix); + Lisp_Object tem = call1 (Qprefix_numeric_value, prefix); args[argnum] = tem; } break; ＠＠ -975,31 +976,13 ＠＠ } } -DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /* -Return numeric meaning of raw prefix argument RAW. -A raw prefix argument is what you get from `(interactive "P")'. -Its numeric meaning is what you would get from `(interactive "p")'. -*/ - (raw)) -{ - if (NILP (raw)) - return Qone; - if (EQ (raw, Qminus)) - return make_fixnum (-1); - if (FIXNUMP (raw)) - return raw; - if (CONSP (raw) && FIXNUMP (XCAR (raw))) - return XCAR (raw); - - return Qone; -} - void syms_of_callint (void) { DEFSYMBOL (Qcall_interactively); DEFSYMBOL (Qread_from_minibuffer); DEFSYMBOL (Qcompleting_read); + DEFSYMBOL (Qprefix_numeric_value); DEFSYMBOL (Qread_file_name); DEFSYMBOL (Qread_directory_name); DEFSYMBOL (Qread_string); ＠＠ -1023,7 +1006,6 ＠＠ DEFSUBR (Finteractive); DEFSUBR (Fcall_interactively); - DEFSUBR (Fprefix_numeric_value); } void diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/cmds.c --- a/src/cmds.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/cmds.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -96,28 +96,6 ＠＠ return Qnil; } -DEFUN ("backward-char", Fbackward_char, 0, 2, "_p", /* -Move point left COUNT characters (right if COUNT is negative). -On attempt to pass end of buffer, stop and signal `end-of-buffer'. -On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. - -The characters that are moved over may be added to the current selection -\(i.e. active region) if the Shift key is held down, a motion key is used -to invoke this command, and `shifted-motion-keys-select-region' is t; see -the documentation for this variable for more details. -*/ - (count, buffer)) -{ - if (NILP (count)) - count = make_fixnum (-1); - else - { - CHECK_FIXNUM (count); - count = make_fixnum (- XFIXNUM (count)); - } - return Fforward_char (count, buffer); -} - DEFUN ("forward-line", Fforward_line, 0, 2, "_p", /* Move COUNT lines forward (backward if COUNT is negative). Precisely, if point is on line I, move to the start of line I + COUNT. ＠＠ -189,25 +167,6 ＠＠ return make_fixnum (end); } -DEFUN ("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /* -Move point to beginning of current line. -With argument COUNT not nil or 1, move forward COUNT - 1 lines first. -If scan reaches end of buffer, stop there without error. -If BUFFER is nil, the current buffer is assumed. - -The characters that are moved over may be added to the current selection -\(i.e. active region) if the Shift key is held down, a motion key is used -to invoke this command, and `shifted-motion-keys-select-region' is t; see -the documentation for this variable for more details. -*/ - (count, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - - BUF_SET_PT (b, XFIXNUM (Fpoint_at_bol (count, buffer))); - return Qnil; -} - DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /* Return the character position of the last character on the current line. With argument COUNT not nil or 1, move forward COUNT - 1 lines first. ＠＠ -231,25 +190,6 ＠＠ n - (n <= 0))); } -DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /* -Move point to end of current line. -With argument COUNT not nil or 1, move forward COUNT - 1 lines first. -If scan reaches end of buffer, stop there without error. -If BUFFER is nil, the current buffer is assumed. - -The characters that are moved over may be added to the current selection -\(i.e. active region) if the Shift key is held down, a motion key is used -to invoke this command, and `shifted-motion-keys-select-region' is t; see -the documentation for this variable for more details. -*/ - (count, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - - BUF_SET_PT (b, XFIXNUM (Fpoint_at_eol (count, buffer))); - return Qnil; -} - DEFUN ("delete-char", Fdelete_char, 0, 2, "*p\nP", /* Delete the following COUNT characters (previous, with negative COUNT). Optional second arg KILLP non-nil means kill instead (save in kill ring). ＠＠ -515,10 +455,7 ＠＠ DEFSYMBOL (Qno_self_insert); DEFSUBR (Fforward_char); - DEFSUBR (Fbackward_char); DEFSUBR (Fforward_line); - DEFSUBR (Fbeginning_of_line); - DEFSUBR (Fend_of_line); DEFSUBR (Fpoint_at_bol); DEFSUBR (Fpoint_at_eol); diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/data.c --- a/src/data.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/data.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -243,22 +243,6 ＠＠ return STRINGP (object) ? Qt : Qnil; } -DEFUN ("arrayp", Farrayp, 1, 1, 0, /* -Return t if OBJECT is an array (string, vector, or bit vector). -*/ - (object)) -{ - return ARRAYP (object) ? Qt : Qnil; -} - -DEFUN ("sequencep", Fsequencep, 1, 1, 0, /* -Return t if OBJECT is a sequence (list or array). -*/ - (object)) -{ - return SEQUENCEP (object) ? Qt : Qnil; -} - DEFUN ("markerp", Fmarkerp, 1, 1, 0, /* Return t if OBJECT is a marker (editor pointer). */ ＠＠ -400,29 +384,6 ＠＠ return INTEGERP (object) ? Qt : Qnil; } -DEFUN ("natnump", Fnatnump, 1, 1, 0, /* -Return t if OBJECT is a nonnegative integer. -*/ - (object)) -{ - return NATNUMP (object) ? Qt : Qnil; -} - -DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /* -Return t if OBJECT is a nonnegative rational. -*/ - (object)) -{ - return NATNUMP (object) -#ifdef HAVE_RATIO - || (RATIOP (object) && ratio_sign (XRATIO_DATA (object)) >= 0) -#endif -#ifdef HAVE_BIGFLOAT - || (BIGFLOATP (object) && bigfloat_sign (XBIGFLOAT_DATA (object)) >= 0) -#endif - ? Qt : Qnil; -} - DEFUN ("numberp", Fnumberp, 1, 1, 0, /* Return t if OBJECT is a number (floating point or rational). */ ＠＠ -4347,15 +4308,11 ＠＠ DEFSUBR (Fintegerp); DEFSUBR (Fnumberp); DEFSUBR (Ffloatp); - DEFSUBR (Fnatnump); - DEFSUBR (Fnonnegativep); DEFSUBR (Fsymbolp); DEFSUBR (Fkeywordp); DEFSUBR (Fstringp); DEFSUBR (Fvectorp); DEFSUBR (Fbit_vector_p); - DEFSUBR (Farrayp); - DEFSUBR (Fsequencep); DEFSUBR (Fmarkerp); DEFSUBR (Fsubrp); DEFSUBR (Fsubr_min_args); diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/device-x.c --- a/src/device-x.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/device-x.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -1716,16 +1716,6 ＠＠ /* display information functions */ /************************************************************************/ -DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /* -Return the default X device for resourcing. -This is the first-created X device that still exists. -See also `default-device'. -*/ - ()) -{ - return get_default_device (Qx); -} - DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /* Return the visual class of the X display DEVICE is using. This can be altered from the default at startup using the XResource "EmacsVisual". ＠＠ -2063,7 +2053,6 ＠＠ DEFSUBR (Fx_get_resource_prefix); DEFSUBR (Fx_put_resource); - DEFSUBR (Fdefault_x_device); DEFSUBR (Fx_display_visual_class); DEFSUBR (Fx_display_visual_depth); DEFSUBR (Fx_server_vendor); diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/doprnt.c --- a/src/doprnt.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/doprnt.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -3418,126 +3418,6 ＠＠ return stream; }  -DEFUN ("format", Fformat, 1, MANY, 0, /* -Format a string out of a control-string and arguments. -The first argument is a control string. -The other arguments are substituted into it to make the result, a string. -It may contain %-sequences meaning to substitute the next argument. -%s means print all objects as-is, using `princ'. -%S means print all objects as s-expressions, using `prin1'. -%d or %i means print as a signed integer in decimal (%o octal, %x lowercase - hex, %X uppercase hex, %b binary). - -%c means print as a single character. -%f means print as a floating-point number in fixed notation (e.g. 785.200). -%e or %E means print as a floating-point number in scientific notation - (e.g. 7.85200e+03). -%g or %G means print as a floating-point number in "pretty format"; - depending on the number, either %f or %e/%E format will be used, and - trailing zeroes are removed from the fractional part. -The argument used for all but %s, %S, and %c must be a number. It will be - converted to an integer or a floating-point number as necessary. In - addition, the integer %-sequences accept character arguments as equivalent - to the corresponding fixnums (see `char-int'), while the floating point - sequences do not. - -%$ means reposition to read a specific numbered argument; for example, - %3$s would apply the `%s' to the third argument after the control string, - and the next format directive would use the fourth argument, the - following one the fifth argument, etc. (There must be a positive integer - between the % and the $). - -Zero or more of the flag characters `-', `+', ` ', `0', `!', '&', `~' and `#' - may be specified between the optional repositioning spec and the conversion - character; see below. - -An optional minimum field width may be specified after any flag characters - and before the conversion character; it specifies the minimum number of - characters that the converted argument will take up. Padding will be - added on the left (or on the right, if the `-' flag is specified), as - necessary. Padding is with zeroes if the `0' flag is specified, with the - character specified following the `!' flag if that is supplied (see below), - or by default with spaces. - -If the field width is specified as `*', the field width is assumed to have - been specified as an argument. Any repositioning specification that - would normally specify the argument to be converted will now specify - where to find this field width argument, not where to find the argument - to be converted. If there is no repositioning specification, the normal - next argument is used. The argument to be converted will be the next - argument after the field width argument unless the precision is also - specified as `*' (see below). - -An optional period character and precision may be specified after any - minimum field width. It specifies the minimum number of digits to - appear in %d, %i, %o, %x, and %X conversions (the number is padded - on the left with zeroes as necessary); the number of digits printed - after the decimal point for %f, %e, and %E conversions; the number - of significant digits printed in %g and %G conversions; and the - maximum number of non-padding characters printed in %s and %S - conversions. The default precision for floating-point conversions - is six. Using a precision with %c is an error. -If the precision is specified as `*', the precision is assumed to have been - specified as an argument. The argument used will be the next argument - after the field width argument, if any. If the field width was not - specified as an argument, any repositioning specification that would - normally specify the argument to be converted will now specify where to - find the precision argument. If there is no repositioning specification, - the normal next argument is used. - -An optional length modifier may be specified after any minimum field width or - precision. The length modifiers available are `hh', `h', `l' (ell), `ll' - \(ell-ell). These mean that a following integer conversion character will - print an integer truncated to eight, sixteen, thirty-two, or sixty-four - bits, respectively. Note that this contrasts with ANSI C, where the bit - length depends on the machine choices for the bit width of various integer - types. - -An optional unsigned modifier, the character `u', may be specified after any - length modifier and before an integer conversion character. This specifies - that the following integer conversion is to treat its argument as unsigned. - If no length modifier is specified, this simply means that `format' will - error if the corresponding integer is negative. With a length modifier - `format' will print a positive integer reflecting the twos' complement - representation of the argument in the given number of bits. E.g. `(format - "%hux" -1)' will return the string "ffff". If no integer conversion - character follows `u', the specification is regarded as equivalent to `ud', - and the argument will be printed in decimal. - -The ` ' and `+' flags mean prefix non-negative numbers with a space or - plus sign, respectively. -The `#' flag means print numbers in an alternate, more verbose format: - octal numbers begin with zero; hex numbers begin with a 0x or 0X; - a decimal point is printed in %f, %e, and %E conversions even if no - numbers are printed after it; and trailing zeroes are not omitted in - %g and %G conversions. -The `&' flag is analogous to the `#' flag for rationals, but the syntax used - to print numbers is that of Common Lisp, rather than C, so octal numbers are - preceded by `#o', binary numbers by `#b' and hexadecimal numbers by `#X' or - `#x' depending on the particular converter character specified. -The `!' flag is followed by a single character, to be used as a pad character - instead of space. It does not override the zero flag. -The `~' flag, when combined with `&' or `#', means to place any sign before - the radix specifier. - -Use %% to put a single % into the output. - -Extent information in CONTROL-STRING and in ARGS are carried over into the -output, in the same way as `concatenate'. Any text created by a character or -numeric %-sequence inherits the extents of the text around it, or of the text -abutting it if those extents' `start-open' and `end-open' properties have the -appropriate values. - -arguments: (CONTROL-STRING &rest ARGS) -*/ - (int nargs, Lisp_Object *args)) -{ - Lisp_Object control_string = args[0]; - - CHECK_STRING (control_string); - return format_into (Qstring, control_string, nargs - 1, args + 1); -} - DEFUN ("format-into", Fformat_into, 2, MANY, 0, /* Like `format', but write the constructed string into STREAM. ＠＠ -3598,6 +3478,5 ＠＠ syms_of_doprnt (void) { DEFSUBR (Fnumber_to_string); - DEFSUBR (Fformat); DEFSUBR (Fformat_into); } diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/editfns.c --- a/src/editfns.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/editfns.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -98,46 +98,6 ＠＠ Vuser_full_name = Fuser_full_name (Qnil); }  -DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /* -Convert CHARACTER to a one-character string containing that character. -*/ - (character)) -{ - Bytecount len; - Ibyte str[MAX_ICHAR_LEN]; - - if (EVENTP (character)) - { - Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil); - if (NILP (ch2)) - invalid_argument - ("key has no character equivalent:", Fcopy_event (character, Qnil)); - character = ch2; - } - - CHECK_CHAR_COERCE_INT (character); - - len = set_itext_ichar (str, XCHAR (character)); - return make_string (str, len); -} - -DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /* -Convert arg STRING to a character, the first character of that string. -An empty string will return the constant `nil'. -*/ - (string)) -{ - CHECK_STRING (string); - - if (XSTRING_LENGTH (string) != 0) - return make_char (string_ichar (string, 0)); - else - /* This used to return Qzero. That is broken, broken, broken. */ - /* It might be kinder to signal an error directly. -slb */ - return Qnil; -} - - DEFUN ("point", Fpoint, 0, 1, 0, /* Return value of point, as an integer. Beginning of buffer is position (point-min). ＠＠ -2239,28 +2199,6 ＠＠ }  -DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /* -Return t if two characters match, optionally ignoring case. -Both arguments must be characters (i.e. NOT integers). -Case is ignored if `case-fold-search' is non-nil in BUFFER. -If BUFFER is nil, the current buffer is assumed. -*/ - (character1, character2, buffer)) -{ - Ichar x1, x2; - struct buffer *b = decode_buffer (buffer, 1); - - CHECK_CHAR_COERCE_INT (character1); - CHECK_CHAR_COERCE_INT (character2); - x1 = XCHAR (character1); - x2 = XCHAR (character2); - - return (!NILP (b->case_fold_search) - ? CANONCASE (b, x1) == CANONCASE (b, x2) - : x1 == x2) - ? Qt : Qnil; -} - #if 0 /* Undebugged FSFmacs code */ /* Transpose the markers in two regions of the current buffer, and adjust the ones between them if necessary (i.e.: if the regions ＠＠ -2383,10 +2321,7 ＠＠ DEFSYMBOL (Qformat); DEFSYMBOL (Quser_files_and_directories); - DEFSUBR (Fchar_equal); DEFSUBR (Fgoto_char); - DEFSUBR (Fstring_to_char); - DEFSUBR (Fchar_to_string); DEFSUBR (Fbuffer_substring); DEFSUBR (Fbuffer_substring_no_properties); diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/event-msw.c --- a/src/event-msw.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/event-msw.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -1993,29 +1993,27 ＠＠ return (HDDEDATA) NULL; { - Lisp_Object args[2]; + Lisp_Object args[] = { Qstring, Qnil, Qnil }; struct gcpro gcpro1; Lisp_Object res; Extbyte *result; DWORD bytes; - args[0] = Qnil; - args[1] = Qnil; GCPRO1 (args[0]); - gcpro1.nvars = 2; + gcpro1.nvars = countof (args); if (!DdeCmpStringHandles (hszItem, mswindows_dde_item_result)) { if (NILP (dde_eval_error)) { - args[0] = build_ascstring ("OK: %s"); - args[1] = dde_eval_result; + args[1] = build_ascstring ("OK: %s"); + args[2] = dde_eval_result; } else { - args[0] = build_ascstring ("ERR: %s"); - args[1] = dde_eval_error; + args[1] = build_ascstring ("ERR: %s"); + args[2] = dde_eval_error; } } else ＠＠ -2031,12 +2029,12 ＠＠ continue; hsz = (HSZ) (int) XFLOAT_DATA (val); if (!DdeCmpStringHandles (hszItem, hsz)) - args[1] = Fsymbol_value (elt); + args[2] = Fsymbol_value (elt); } - args[0] = build_ascstring ("%s"); + args[1] = build_ascstring ("%s"); } - res = Fformat (2, args); + res = Fformat_into (countof (args), args); UNGCPRO; bytes = (uFmt == CF_TEXT ? 1 : 2) * (XSTRING_LENGTH (res) + 1); diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/fileio.c --- a/src/fileio.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/fileio.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -1840,7 +1840,7 ＠＠ if (!IS_DIRECTORY_SEP (string_byte (newname, XSTRING_LENGTH (newname) - 1))) - args[i++] = Fchar_to_string (Vdirectory_sep_char); + args[i++] = Fstring (1, &Vdirectory_sep_char); args[i++] = Ffile_name_nondirectory (filename); newname = concatenate (i, args, Qstring, 0); NUNGCPRO; diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/lisp.h --- a/src/lisp.h Sat Mar 23 18:03:32 2019 -0600 +++ b/src/lisp.h Fri Mar 22 07:41:56 2019 +0000 ＠＠ -4559,9 +4559,9 ＠＠ /* Defined in callint.c */ EXFUN (Fcall_interactively, 3); -EXFUN (Fprefix_numeric_value, 1); extern Lisp_Object Qcall_interactively; extern Lisp_Object Qmouse_leave_buffer_hook; +extern Lisp_Object Qprefix_numeric_value; extern Lisp_Object Qread_from_minibuffer; extern Lisp_Object Vcommand_history; extern Lisp_Object Vcurrent_prefix_arg; ＠＠ -4589,8 +4589,8 ＠＠ extern Lisp_Object Vdisabled_command_hook; /* Defined in cmds.c */ -EXFUN (Fbeginning_of_line, 2); -EXFUN (Fend_of_line, 2); +EXFUN (Fpoint_at_bol, 2); +EXFUN (Fpoint_at_eol, 2); EXFUN (Fforward_char, 2); EXFUN (Fforward_line, 2); extern Lisp_Object Qself_insert_command; ＠＠ -4801,13 +4801,12 ＠＠ EXFUN (Fbolp, 1); EXFUN (Fbuffer_substring, 3); EXFUN (Fchar_after, 2); -EXFUN (Fchar_to_string, 1); EXFUN (Fcurrent_time, 0); EXFUN (Fdelete_region, 3); EXFUN (Feobp, 1); EXFUN (Feolp, 1); EXFUN (Ffollowing_char, 1); -EXFUN (Fformat, MANY); +EXFUN (Fformat_into, MANY); EXFUN (Fgoto_char, 2); EXFUN (Finsert, MANY); EXFUN (Finsert_buffer_substring, 3); diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/lread.c --- a/src/lread.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/lread.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -1616,10 +1616,10 ＠＠ if (CONSP (val) && UNBOUNDP (XCAR (val))) { - Ichar c = XCHAR (XCDR (val)); + Lisp_Object c = XCDR (val); + CHECK_CHAR (c); free_cons (val); - return Fsignal (Qinvalid_read_syntax, - list1 (Fchar_to_string (make_char (c)))); + return Fsignal (Qinvalid_read_syntax, list1 (Fstring (1, &c))); } return val; diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/macros.c --- a/src/macros.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/macros.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -103,7 +103,7 ＠＠ { /* This function can GC */ struct console *con = XCONSOLE (Vselected_console); - int repeat; + EMACS_INT repeat; if (NILP (con->defining_kbd_macro)) invalid_operation ("Not defining kbd macro", Qunbound); ＠＠ -111,7 +111,11 ＠＠ if (NILP (arg)) repeat = -1; else - repeat = XFIXNUM (Fprefix_numeric_value (arg)); + { + arg = call1 (Qprefix_numeric_value, arg); + CHECK_FIXNUM (arg); + repeat = XFIXNUM (arg); + } if (!NILP (con->defining_kbd_macro)) { ＠＠ -252,13 +256,14 ＠＠ /* This function can GC */ Lisp_Object final; int speccount = specpdl_depth (); - int repeat = 1; + EMACS_INT repeat = 1; struct gcpro gcpro1; struct console *con = XCONSOLE (Vselected_console); if (!NILP (count)) { - count = Fprefix_numeric_value (count); + count = call1 (Qprefix_numeric_value, count); + CHECK_FIXNUM (count); repeat = XFIXNUM (count); } diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/scrollbar.c --- a/src/scrollbar.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/scrollbar.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -716,7 +716,7 ＠＠ Fmove_to_window_line (make_fixnum (-1), win); if (selected) - Fbeginning_of_line (Qnil, buf); + BUF_SET_PT (XBUFFER (buf), XFIXNUM (Fpoint_at_bol (Qnil, buf))); else { /* #### Taken from forward-line. */ diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/sunpro.c --- a/src/sunpro.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/sunpro.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -58,13 +58,15 ＠＠ ) { #ifdef USAGE_TRACKING - Lisp_Object xs; + Lisp_Object xs, *fi_args; unsigned char *s; if (!NILP (Vusage_tracking)) { - xs = Fformat (nargs, args); - CHECK_STRING (xs); + fi_args = alloca_array (Lisp_Object, nargs + 1); + fi_args[0] = Qstring; + memmove (fi_args + 1, args, nargs * sizeof (Lisp_Object)); + xs = Fformat_into (nargs + 1, fi_args); s = XSTRING_DATA (xs); ut_log_text ((char *) s); } diff -r c0ed7ef9a5a1 -r 8110c5579c84 src/window.c --- a/src/window.c Sat Mar 23 18:03:32 2019 -0600 +++ b/src/window.c Fri Mar 22 07:41:56 2019 +0000 ＠＠ -4701,7 +4701,8 ＠＠ direction *= -1; else { - count = Fprefix_numeric_value (count); + count = call1 (Qprefix_numeric_value, count); + CHECK_FIXNUM (count); value = XFIXNUM (count) * direction; if (!value) ＠＠ -5037,9 +5038,18 ＠＠ { Lisp_Object window = Fselected_window (Qnil); struct window *w = XWINDOW (window); - int n = (NILP (count) ? - window_char_width (w, 0) - 2 : - XFIXNUM (Fprefix_numeric_value (count))); + EMACS_INT n; + + if (NILP (count)) + { + n = window_char_width (w, 0) - 2; + } + else + { + count = call1 (Qprefix_numeric_value, count); + CHECK_FIXNUM (count); + n = XFIXNUM (count); + } return Fset_window_hscroll (window, make_fixnum (w->hscroll + n)); } ＠＠ -5057,9 +5067,18 ＠＠ { Lisp_Object window = Fselected_window (Qnil); struct window *w = XWINDOW (window); - int n = (NILP (count) ? - window_char_width (w, 0) - 2 : - XFIXNUM (Fprefix_numeric_value (count))); + EMACS_INT n; + + if (NILP (count)) + { + n = window_char_width (w, 0) - 2; + } + else + { + count = call1 (Qprefix_numeric_value, count); + CHECK_FIXNUM (count); + n = XFIXNUM (count); + } return Fset_window_hscroll (window, make_fixnum (w->hscroll - n)); } ＠＠ -5080,7 +5099,7 ＠＠ startp = start_with_line_at_pixpos (w, opoint, window_half_pixpos (w)); else { - n = Fprefix_numeric_value (n); + n = call1 (Qprefix_numeric_value, n); CHECK_FIXNUM (n); startp = start_with_point_on_display_line (w, opoint, XFIXNUM (n)); } ＠＠ -5171,7 +5190,8 ＠＠ else { /* #### Is this going to work right when at eob? */ - arg = Fprefix_numeric_value (arg); + arg = call1 (Qprefix_numeric_value, arg); + CHECK_FIXNUM (arg); if (XFIXNUM (arg) < 0) arg = make_fixnum (XFIXNUM (arg) + height); } -- ‘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)