March 2019 - XEmacs-Patches - XEmacs Mailing List Archives

[COMMIT] Accept characters as keysyms, #'x-keysym-on-keyboard{-sans-modifiers,}-p 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1553800232 0 # Thu Mar 28 19:10:32 2019 +0000 # Node ID 2d6c322fbf809281bc28220a2c724b37b5ec1ba2 # Parent 981577593cb6a67bea720c2f55fd74447f1b508f Accept characters as keysyms, #'x-keysym-on-keyboard{-sans-modifiers,}-p lisp/ChangeLog addition: 2019-03-28 Aidan Kehoe <kehoea(a)parhasard.net> * x-init.el (pseudo-canonicalize-keysym): * x-init.el (x-keysym-on-keyboard-sans-modifiers-p): * x-init.el (x-keysym-on-keyboard-p): Accept characters as keysyms in these functions, as well as strings and symbols. This is needed since changeset a69c6e871607 of 2017-12-20, which applied to the C code. diff -r 981577593cb6 -r 2d6c322fbf80 lisp/ChangeLog --- a/lisp/ChangeLog Wed Mar 27 21:10:36 2019 +0000 +++ b/lisp/ChangeLog Thu Mar 28 19:10:32 2019 +0000 ＠＠ -1,3 +1,12 ＠＠ +2019-03-28 Aidan Kehoe <kehoea(a)parhasard.net> + + * x-init.el (pseudo-canonicalize-keysym): + * x-init.el (x-keysym-on-keyboard-sans-modifiers-p): + * x-init.el (x-keysym-on-keyboard-p): + Accept characters as keysyms in these functions, as well as + strings and symbols. This is needed since changeset a69c6e871607 + of 2017-12-20, which applied to the C code. + 2019-03-21 Jerry James <james(a)xemacs.org> * startup.el (startup-setup-paths): Silence startup warnings due to diff -r 981577593cb6 -r 2d6c322fbf80 lisp/x-init.el --- a/lisp/x-init.el Wed Mar 27 21:10:36 2019 +0000 +++ b/lisp/x-init.el Thu Mar 28 19:10:32 2019 +0000 ＠＠ -89,50 +89,67 ＠＠ (labels ((pseudo-canonicalize-keysym (keysym) - "If KEYSYM (a string or a symbol) might describe a keysym on -the current keyboard, return its canonical XEmacs form, a symbol; + "If KEYSYM (a string, symbol or character) might describe a keysym on +the current keyboard, return its canonical XEmacs form, a character or symbol; otherwise return nil. Does not intern new symbols, since if a string doesn't correspond to a keysym that XEmacs has seen, that string won't be in obarray." - (if (symbolp keysym) - keysym - (if (stringp keysym) - (or (intern-soft keysym) - (intern-soft (nsubstitute ?- ?_ (downcase keysym)))))))) + (cond + ((symbolp keysym) keysym) + ((stringp keysym) (or (intern-soft keysym) + (intern-soft + (nsubstitute ?- ?_ + (downcase keysym))))) + ((characterp keysym) keysym)))) (declare (inline pseudo-canonicalize-keysym)) (defun x-keysym-on-keyboard-sans-modifiers-p (keysym &optional device) "Return true if KEYSYM names a key on the keyboard of DEVICE. -More precisely, return true if pressing a physical key -on the keyboard of DEVICE without any modifier keys generates KEYSYM. + +More precisely, return true if pressing a physical key on the keyboard +of DEVICE without any modifier keys generates KEYSYM. + Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -The keysym name can be provided in two forms: -- if keysym is a string, it must be the name as known to X windows. -- if keysym is a symbol, it must be the name as known to XEmacs. -The two names differ in capitalization and underscoring." + +KEYSYM can be provided in three forms: +- if KEYSYM is a string, it must be the name as known to X windows. +- if KEYSYM is a symbol, it must be the name as known to XEmacs. +- KEYSYM may also be a Lisp character. +The two multi-character names names differ in capitalization and +underscoring. + +For consistency with the other device implementations, the XEmacs X11 code +uses a Lisp character object as the keysym for an X11 key, if there is a known +correspondence between that key and a Lisp character. There are a few ASCII +exceptions, including backspace, tab, space. It previously used symbols that +reflected the X11 keysym names for these keys too, and you may see old code +that assumes this. Such code should be fixed as appropriate." (eq 'sans-modifiers (gethash (pseudo-canonicalize-keysym keysym) (x-keysym-hash-table device)))) (defun x-keysym-on-keyboard-p (keysym &optional device) "Return true if KEYSYM names a key on the keyboard of DEVICE. + More precisely, return true if some keystroke (possibly including modifiers) on the keyboard of DEVICE keys generates KEYSYM. + Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -The keysym name can be provided in two forms: -- if keysym is a string, it must be the name as known to X windows. -- if keysym is a symbol, it must be the name as known to XEmacs. -The two names differ in capitalization and underscoring. + +KEYSYM can be provided in three forms: +- if KEYSYM is a string, it must be the name as known to X windows. +- if KEYSYM is a symbol, it must be the name as known to XEmacs. +- KEYSYM may also be a Lisp character. +The two multi-character names differ in capitalization and underscoring. -This function is not entirely trustworthy, in that Xlib compose processing -can produce keysyms that XEmacs will not have seen when it examined the -keysyms available on startup. So pressing `dead-diaeresis' and then 'a' may -pass `adiaeresis' to XEmacs, or (in some implementations) even `U00E4', -where `(x-keysym-on-keyboard-p 'adiaeresis)' and `(x-keysym-on-keyboard-p -'U00E4)' would both have returned nil. Subsequent to XEmacs seeing a keysym -it was previously unaware of, the predicate will take note of it, though." +For consistency with the other device implementations, the XEmacs X11 code +uses a Lisp character object as the keysym for an X11 key, if there is a known +correspondence between that key and a Lisp character. There are a few ASCII +exceptions, including backspace, tab, space. It previously used symbols that +reflected the X11 keysym names for these keys too, and you may see old code +that assumes this. Such code should be fixed as appropriate." (and (gethash (pseudo-canonicalize-keysym keysym) (x-keysym-hash-table device)) t))) -- ‘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] Drop #'user-name-completion-1, give multiple vals in #'user-name-completion 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1553721036 0 # Wed Mar 27 21:10:36 2019 +0000 # Node ID 981577593cb6a67bea720c2f55fd74447f1b508f # Parent 8110c5579c84377541e0dc765bea9cec942292f0 Drop #'user-name-completion-1, give multiple vals in #'user-name-completion src/ChangeLog addition: 2019-03-27 Aidan Kehoe <kehoea(a)parhasard.net> * dired.c: * dired.c (Fuser_name_completion): * dired.c (user_name_completion): * dired.c (syms_of_dired): Remove Fuser_name_completion_1(), return its CDR as the second value from Fuser_name_completion() instead. lisp/ChangeLog addition: 2019-03-27 Aidan Kehoe <kehoea(a)parhasard.net> * minibuf.el (read-file-name-internal-1): Revise this now #'user-name-completion returns two values and #'user-name-completion-1 is no longer available. diff -r 8110c5579c84 -r 981577593cb6 lisp/ChangeLog --- a/lisp/ChangeLog Fri Mar 22 07:41:56 2019 +0000 +++ b/lisp/ChangeLog Wed Mar 27 21:10:36 2019 +0000 ＠＠ -49,6 +49,12 ＠＠ * x-misc.el (default-x-device): New. Move this from device-x.c. +2019-03-27 Aidan Kehoe <kehoea(a)parhasard.net> + + * minibuf.el (read-file-name-internal-1): + Revise this now #'user-name-completion returns two values and + #'user-name-completion-1 is no longer available. + 2011-03-05 Aidan Kehoe <kehoea(a)parhasard.net> * bytecomp.el: diff -r 8110c5579c84 -r 981577593cb6 lisp/minibuf.el --- a/lisp/minibuf.el Fri Mar 22 07:41:56 2019 +0000 +++ b/lisp/minibuf.el Wed Mar 27 21:10:36 2019 +0000 ＠＠ -1728,25 +1728,22 ＠＠ (name (if orig (file-name-nondirectory sstring) string)) (direct (if specdir (expand-file-name specdir dir) dir))) ;; ~username completion - (if (and (fboundp 'user-name-completion-1) - (string-match "^[~]" name)) + (if (and (> (length name) 0) (eql ?~ (aref name 0))) (let ((user (substring name 1))) (cond ((eq action 'lambda) (file-directory-p name)) - ((eq action 't) + ((eq action t) ;; all completions (mapcar #'(lambda (p) (concat "~" p)) - (declare-fboundp - (user-name-all-completions user)))) + (user-name-all-completions user))) (t;; 'nil ;; complete - (let* ((val+uniq (declare-fboundp - (user-name-completion-1 user))) - (val (car val+uniq)) - (uniq (cdr val+uniq))) + (multiple-value-bind (val uniq) + (user-name-completion user) (cond ((stringp val) (if uniq - (file-name-as-directory (concat "~" val)) + (file-name-as-directory + (concat "~" val)) (concat "~" val))) ((eq val t) (file-name-as-directory name)) diff -r 8110c5579c84 -r 981577593cb6 src/ChangeLog --- a/src/ChangeLog Fri Mar 22 07:41:56 2019 +0000 +++ b/src/ChangeLog Wed Mar 27 21:10:36 2019 +0000 ＠＠ -69,6 +69,15 ＠＠ Call #'prefix-numeric-value through its Lisp symbol here, now it's no longer in C. +2019-03-27 Aidan Kehoe <kehoea(a)parhasard.net> + + * dired.c: + * dired.c (Fuser_name_completion): + * dired.c (user_name_completion): + * dired.c (syms_of_dired): + Remove Fuser_name_completion_1(), return its CDR as the second + value from Fuser_name_completion() instead. + 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> Mechanically change byte_marker_position() to diff -r 8110c5579c84 -r 981577593cb6 src/dired.c --- a/src/dired.c Fri Mar 22 07:41:56 2019 +0000 +++ b/src/dired.c Wed Mar 27 21:10:36 2019 +0000 ＠＠ -513,39 +513,26 ＠＠ static Lisp_Object user_name_completion (Lisp_Object user, int all_flag, - int *uniq); + Lisp_Object *uniq); DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /* Complete user name from PARTIAL-USERNAME. + Return the longest prefix common to all user names starting with PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches it exactly, returns t. Return nil if there is no user name starting with PARTIAL-USERNAME. + +This function returns two values, see `multiple-value-bind'. The second value +is non-nil if and only if the completion returned as the first value was +unique. */ (partial_username)) { - return user_name_completion (partial_username, 0, NULL); -} - -DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /* -Complete user name from PARTIAL-USERNAME. - -This function is identical to `user-name-completion', except that -the cons of the completion and an indication of whether the -completion was unique is returned. + Lisp_Object valz[] = { Qnil, Qnil }; -The car of the returned value is the longest prefix common to all user -names that start with PARTIAL-USERNAME. If there is only one and -PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if -there is no user name starting with PARTIAL-USERNAME. The cdr of the -result is non-nil if and only if the completion returned in the car -was unique. -*/ - (partial_username)) -{ - int uniq; - Lisp_Object completed = user_name_completion (partial_username, 0, &uniq); - return Fcons (completed, uniq ? Qt : Qnil); + valz[0] = user_name_completion (partial_username, 0, valz + 1); + return Fvalues (countof (valz), valz); } DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /* ＠＠ -601,7 +588,7 ＠＠ #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */ static Lisp_Object -user_name_completion (Lisp_Object user, int all_flag, int *uniq) +user_name_completion (Lisp_Object user, int all_flag, Lisp_Object *uniq) { /* This function can GC */ int matchcount = 0; ＠＠ -765,7 +752,7 ＠＠ UNGCPRO; if (uniq) - *uniq = (matchcount == 1); + *uniq = (matchcount == 1) ? Qt : Qnil; if (all_flag || NILP (bestmatch)) return bestmatch; ＠＠ -968,7 +955,6 ＠＠ DEFSUBR (Ffile_name_completion); DEFSUBR (Ffile_name_all_completions); DEFSUBR (Fuser_name_completion); - DEFSUBR (Fuser_name_completion_1); DEFSUBR (Fuser_name_all_completions); DEFSUBR (Ffile_attributes); } -- ‘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 xemacs-base] Don't rely on #'user-name-completion-1's current behaviour, comint.el 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1553719596 0 # Wed Mar 27 20:46:36 2019 +0000 # Node ID e2ab121db02725cba44e974c06262301bd5edf3b # Parent 1891d40eea7023046d32a7891a2065c65618370f Don't rely on #'user-name-completion-1's current behaviour, comint.el 2019-03-27 Aidan Kehoe <kehoea(a)parhasard.net> * comint.el (comint-dynamic-complete-as-username): Update this to reflect pending changes removing #'user-name-completion-1. diff -r 1891d40eea70 -r e2ab121db027 ChangeLog --- a/ChangeLog Sun Jun 10 17:11:11 2018 +0100 +++ b/ChangeLog Wed Mar 27 20:46:36 2019 +0000 ＠＠ -1,3 +1,9 ＠＠ +2019-03-27 Aidan Kehoe <kehoea(a)parhasard.net> + + * comint.el (comint-dynamic-complete-as-username): + Update this to reflect pending changes removing + #'user-name-completion-1. + 2018-06-10 Aidan Kehoe <kehoea(a)parhasard.net> * Makefile (VERSION): XEmacs package 2.46 released. diff -r 1891d40eea70 -r e2ab121db027 comint.el --- a/comint.el Sun Jun 10 17:11:11 2018 +0100 +++ b/comint.el Wed Mar 27 20:46:36 2019 +0000 ＠＠ -2318,15 +2318,25 ＠＠ (filename (or (comint-match-partial-filename) "")) (pathdir (file-name-directory filename)) (pathnondir (file-name-nondirectory filename))) - (if (and (fboundp 'user-name-completion-1) - (string-match "^[~]" pathnondir) + (if (and (> (length pathnondir) 0) (eql ?~ (aref pathnondir 0)) (not pathdir)) (let* ((user (substring pathnondir 1)) - (compl+uniq (user-name-completion-1 user)) - (completion (car compl+uniq)) - (uniq (cdr compl+uniq))) + completion uniq completion+uniq) + (if (fboundp 'user-name-completion-1) + (setq completion+uniq (user-name-completion-1 user) + completion (car completion+uniq) + uniq (cdr completion+uniq)) + (if (eval-when-compile + (subrp (symbol-function 'multiple-value-call))) + (multiple-value-setq (completion uniq) + (user-name-completion user)) + ;; This will work with a 21.4 byte compiler on a 21.5 XEmacs: + (eval '(multiple-value-setq (completion uniq) + (user-name-completion user))))) (cond ((null completion) - (if minibuffer-p (ding) (message "No completions of %s" filename)) + (if minibuffer-p + (ding) + (message "No completions of %s" filename)) (setq success nil)) ((eq completion t) ; Means already completed "file". (insert dirsuffix) -- ‘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 several more non-loop-hotspot functions from C to Lisp. 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # 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> 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> 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>. +2019-03-21 Aidan Kehoe <kehoea(a)parhasard.net> + + 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> * 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> + + 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> 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)

1 participants
0 comments

xemacs-patches@xemacs.org UPGRADE YOUR MAILBOX QUOTA!!! 5 years, 9 months

Mr. X

Spam detection software, running on the system "mars.taur.is", has identified this incoming email as possible spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see ＠＠CONTACT_ADDRESS＠＠ for details. Content preview: Email Security Alert for xemacs-patches(a)xemacs.org Dear xemacs-patches(a)xemacs.org Our server detects that your email storage has exceeded its limit and needs to be upgraded immediately [...] Content analysis details: (5.8 points, 4.7 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 URIBL_BLOCKED ADMINISTRATOR NOTICE: The query to URIBL was blocked. See http://wiki.apache.org/spamassassin/DnsBlocklists#dnsbl-block for more information. [URIs: xemacs.org] 0.6 URIBL_PH_SURBL Contains an URL listed in the PH SURBL blocklist [URIs: lenceriacasasol.com.ar] 1.3 RCVD_IN_RP_RNBL RBL: Relay in RNBL, https://senderscore.org/blacklistlookup/ [185.193.38.142 listed in bl.score.senderscore.com] 1.4 RCVD_IN_BRBL_LASTEXT RBL: No description available. [185.193.38.142 listed in bb.barracudacentral.org] 0.0 FSL_HELO_NON_FQDN_1 No description available. 0.8 FROM_NO_USER From: has no local-part before ＠ sign 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4991] 0.0 HTML_FONT_LOW_CONTRAST BODY: HTML font color similar or identical to background 0.0 HTML_MESSAGE BODY: HTML included in message 0.0 HK_NAME_MR_MRS No description available. 0.8 RDNS_NONE Delivered to internal network by a host with no rDNS The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor.

1 participants
0 comments

[COMMIT] Warn if CONTROL-STRING is not constant, #'format, #'message. 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1552506428 0 # Wed Mar 13 19:47:08 2019 +0000 # Node ID 680638011e1445530ab21276b6ded53554768dd0 # Parent 9061f6baa93095d8fbd6b487a4ef8f12acc620c4 Warn if CONTROL-STRING is not constant, #'format, #'message. 2011-03-05 Aidan Kehoe <kehoea(a)parhasard.net> * bytecomp.el: * bytecomp.el (byte-compile-default-warnings): * bytecomp.el (byte-compiler-legal-options): * bytecomp.el (byte-compile-format): New. * bytecomp.el (byte-compile-message): New. Introduce `byte-compile-format', which warns if CONTROL-STRING is not constant, something that is reasonably often a security issue. Suppress this warning for calls to #'gettext, or if-statements both branches of which are constant strings. diff -r 9061f6baa930 -r 680638011e14 lisp/ChangeLog --- a/lisp/ChangeLog Sun Mar 10 18:02:36 2019 +0000 +++ b/lisp/ChangeLog Wed Mar 13 19:47:08 2019 +0000 ＠＠ -1,3 +1,15 ＠＠ +2011-03-05 Aidan Kehoe <kehoea(a)parhasard.net> + + * bytecomp.el: + * bytecomp.el (byte-compile-default-warnings): + * bytecomp.el (byte-compiler-legal-options): + * bytecomp.el (byte-compile-format): New. + * bytecomp.el (byte-compile-message): New. + Introduce `byte-compile-format', which warns if CONTROL-STRING is + not constant, something that is reasonably often a security + issue. Suppress this warning for calls to #'gettext, or + if-statements both branches of which are constant strings. + 2018-10-07 Aidan Kehoe <kehoea(a)parhasard.net> * font-lock.el (font-lock-fontify-syntactically-region): diff -r 9061f6baa930 -r 680638011e14 lisp/bytecomp.el --- a/lisp/bytecomp.el Sun Mar 10 18:02:36 2019 +0000 +++ b/lisp/bytecomp.el Wed Mar 13 19:47:08 2019 +0000 ＠＠ -121,6 +121,8 ＠＠ ;;; as data, not as a function, ;;; and using it in a function ;;; context ) +;;; 'format-not-constant (using #'format without +;;; a constant CONTROL-STRING) ;;; emacs-lisp-file-regexp Regexp for the extension of source-files; ;;; see also the function `byte-compile-dest-file'. ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. ＠＠ -342,7 +344,7 ＠＠ ;; byte-compile-warning-types in FSF. (defvar byte-compile-default-warnings '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete - discarded-consing quoted-lambda) + discarded-consing quoted-lambda format-not-constant) "*The warnings used when byte-compile-warnings is t.") (defvar byte-compile-warnings t ＠＠ -1419,7 +1421,8 ＠＠ (new-bytecodes byte-compile-new-bytecodes (t nil) val) (warnings byte-compile-warnings ((callargs subr-callargs redefine free-vars unused-vars - unresolved discarded-consing quoted-lambda)) + unresolved discarded-consing quoted-lambda + format-not-constant)) val))) ;; XEmacs addition ＠＠ -4186,6 +4189,8 ＠＠ (byte-defop-compiler-1 let*) (byte-defop-compiler-1 integerp) +(byte-defop-compiler-1 format) +(byte-defop-compiler-1 message) (byte-defop-compiler-1 eql) (byte-defop-compiler-1 fillarray) (byte-defop-compiler-1 gensym) ＠＠ -4490,6 +4495,25 ＠＠ (prin1-to-string (nth 1 form))))) (byte-compile-normal-call form)) +(defun byte-compile-format (form) + (labels ((sufficiently-constant-stringp (form) + (or (stringp form) + (and (eq 'if (car-safe form)) + (every #'sufficiently-constant-stringp (cddr form))) + (and (or (eq 'gettext (car-safe form)) + (eq 'substitute-command-keys (car-safe form))) + (every #'sufficiently-constant-stringp (cdr form)))))) + (when (and (memq 'format-not-constant byte-compile-warnings) + (not (sufficiently-constant-stringp (second form)))) + (byte-compile-warn "#'%s called with a non-constant CONTROL-STRING, %S" + (first form) (second form))) + (byte-compile-normal-call form))) + +(defun byte-compile-message (form) + (if (and (null (second form)) (eql 2 (length form))) + (byte-compile-normal-call form) + (byte-compile-format form))) + ;;(byte-defop-compiler-1 /= byte-compile-negated) (byte-defop-compiler-1 atom byte-compile-negated) (byte-defop-compiler-1 nlistp byte-compile-negated) -- ‘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] Mechanically change byte_marker_position() to marker_byte_position(). 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1552240956 0 # Sun Mar 10 18:02:36 2019 +0000 # Node ID 9061f6baa93095d8fbd6b487a4ef8f12acc620c4 # Parent 5d1f8a39a8d09a49b87b25c7b27b09fa8b3059c0 Mechanically change byte_marker_position() to marker_byte_position(). 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> Mechanically change byte_marker_position() to marker_byte_position(), the GNU name for the same function, in our C sources. Include set_byte_marker_position() -> set_marker_byte_position() in this for symmetry, despite that GNU doesn't use the latter name. * bytecode.c (bytecode_arithcompare): * bytecode.c (bytecode_gtr): * bytecode.c (bytecode_lss): * bytecode.c (bytecode_leq): * bytecode.c (bytecode_geq): * bytecode.c (bytecode_arithop): * callint.c (check_mark): * callint.c (callint_prompt): * data.c (ARITHCOMPARE_MANY): * data.c (Fmax): * data.c (Fmin): * editfns.c (region_limit): * editfns.c (Fpoint_min_marker): * editfns.c (Fpoint_max_marker): * editfns.c (save_restriction_save): * editfns.c (save_restriction_restore): * extents.h: * fileio.c: * fileio.c (restore_point_unwind): * line-number.c (invalidate_line_number_cache): * line-number.c (get_nearest_line_number): * line-number.c (add_position_to_cache): * lisp.h: * lread.c (readchar): * lread.c (unreadchar): * lstream.c (lisp_buffer_reader): * lstream.c (lisp_buffer_rewinder): * lstream.c (lisp_buffer_marker): * marker.c (set_byte_marker_position): * marker.c (byte_marker_position): * marker.c (copy_marker_1): * print.c (output_string): * redisplay-output.c (redisplay_move_cursor): * redisplay-output.c (redisplay_update_line): * redisplay-output.c (redisplay_output_window): * redisplay.c (generate_display_line): * redisplay.c (create_text_block): * redisplay.c (regenerate_window_extents_only_changed): * redisplay.c (redisplay_window): * redisplay.c (decode_mode_spec): * syntax.c (signal_syntax_cache_extent_changed): * text.c (get_buffer_pos_byte): * window.c (Fset_window_start): * window.c (unshow_buffer): * window.c (Fdelete_other_windows): * window.c (Fset_window_buffer): * window.c (window_scroll): * window.c (Fcenter_to_window_line): * window.c (Fmove_to_window_line): diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/ChangeLog --- a/src/ChangeLog Sun Mar 10 17:24:04 2019 +0000 +++ b/src/ChangeLog Sun Mar 10 18:02:36 2019 +0000 ＠＠ -1,3 +1,61 ＠＠ +2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> + + Mechanically change byte_marker_position() to + marker_byte_position(), the GNU name for the same function, in our + C sources. + Include set_byte_marker_position() -> set_marker_byte_position() + in this for symmetry, despite that GNU doesn't use the latter + name. + * bytecode.c (bytecode_arithcompare): + * bytecode.c (bytecode_gtr): + * bytecode.c (bytecode_lss): + * bytecode.c (bytecode_leq): + * bytecode.c (bytecode_geq): + * bytecode.c (bytecode_arithop): + * callint.c (check_mark): + * callint.c (callint_prompt): + * data.c (ARITHCOMPARE_MANY): + * data.c (Fmax): + * data.c (Fmin): + * editfns.c (region_limit): + * editfns.c (Fpoint_min_marker): + * editfns.c (Fpoint_max_marker): + * editfns.c (save_restriction_save): + * editfns.c (save_restriction_restore): + * extents.h: + * fileio.c: + * fileio.c (restore_point_unwind): + * line-number.c (invalidate_line_number_cache): + * line-number.c (get_nearest_line_number): + * line-number.c (add_position_to_cache): + * lisp.h: + * lread.c (readchar): + * lread.c (unreadchar): + * lstream.c (lisp_buffer_reader): + * lstream.c (lisp_buffer_rewinder): + * lstream.c (lisp_buffer_marker): + * marker.c (set_byte_marker_position): + * marker.c (byte_marker_position): + * marker.c (copy_marker_1): + * print.c (output_string): + * redisplay-output.c (redisplay_move_cursor): + * redisplay-output.c (redisplay_update_line): + * redisplay-output.c (redisplay_output_window): + * redisplay.c (generate_display_line): + * redisplay.c (create_text_block): + * redisplay.c (regenerate_window_extents_only_changed): + * redisplay.c (redisplay_window): + * redisplay.c (decode_mode_spec): + * syntax.c (signal_syntax_cache_extent_changed): + * text.c (get_buffer_pos_byte): + * window.c (Fset_window_start): + * window.c (unshow_buffer): + * window.c (Fdelete_other_windows): + * window.c (Fset_window_buffer): + * window.c (window_scroll): + * window.c (Fcenter_to_window_line): + * window.c (Fmove_to_window_line): + 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> Make the modiff, save_modiff, face_change, auto_save_modified diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/bytecode.c --- a/src/bytecode.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/bytecode.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -310,8 +310,8 ＠＠ #endif case LAZY_MARKER_T: { - Bytebpos ival1 = byte_marker_position (obj1); - Bytebpos ival2 = byte_marker_position (obj2); + Bytebpos ival1 = marker_byte_position (obj1); + Bytebpos ival2 = marker_byte_position (obj2); return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; } ＠＠ -335,8 +335,8 ＠＠ if (MARKERP (obj2) && (XMARKER (obj1)->buffer == XMARKER (obj2)->buffer)) { - Bytebpos bpval1 = byte_marker_position (obj1); - Bytebpos bpval2 = byte_marker_position (obj2); + Bytebpos bpval1 = marker_byte_position (obj1); + Bytebpos bpval2 = marker_byte_position (obj2); return bpval1 < bpval2 ? -1 : bpval1 > bpval2 ? 1 : 0; } ＠＠ -393,7 +393,7 ＠＠ { if (MARKERP (obj1) && FIXNUMP (obj2)) { - const Bytebpos pos1 = byte_marker_position (obj1); + const Bytebpos pos1 = marker_byte_position (obj1); const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1); /* (POS1 / MAX_ICHAR_LEN) is a lower bound on OBJ1's character length, ＠＠ -412,7 +412,7 ＠＠ } else if (FIXNUMP (obj1) && MARKERP (obj2)) { - const Bytebpos pos2 = byte_marker_position (obj2); + const Bytebpos pos2 = marker_byte_position (obj2); const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2); /* The byte marker position is an upper limit on the character marker ＠＠ -444,7 +444,7 ＠＠ /* See bytecode_gtr() for the reasoning for the following. */ if (MARKERP (obj1) && FIXNUMP (obj2)) { - const Bytebpos pos1 = byte_marker_position (obj1); + const Bytebpos pos1 = marker_byte_position (obj1); const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1); if (pos1 < XFIXNUM (obj2)) ＠＠ -458,7 +458,7 ＠＠ } else if (FIXNUMP (obj1) && MARKERP (obj2)) { - const Bytebpos pos2 = byte_marker_position (obj2); + const Bytebpos pos2 = marker_byte_position (obj2); const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2); if (XFIXNUM (obj1) < cpos2min) ＠＠ -480,7 +480,7 ＠＠ /* See bytecode_gtr() for the reasoning for the following. */ if (MARKERP (obj1) && FIXNUMP (obj2)) { - const Bytebpos pos1 = byte_marker_position (obj1); + const Bytebpos pos1 = marker_byte_position (obj1); const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1); if (pos1 <= XREALFIXNUM (obj2)) ＠＠ -494,7 +494,7 ＠＠ } else if (FIXNUMP (obj1) && MARKERP (obj2)) { - const Bytebpos pos2 = byte_marker_position (obj2); + const Bytebpos pos2 = marker_byte_position (obj2); const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2); if (XREALFIXNUM (obj1) <= cpos2min) ＠＠ -516,7 +516,7 ＠＠ /* See bytecode_gtr() for the reasoning for the following. */ if (MARKERP (obj1) && FIXNUMP (obj2)) { - const Bytebpos pos1 = byte_marker_position (obj1); + const Bytebpos pos1 = marker_byte_position (obj1); const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1); if (cpos1min >= XREALFIXNUM (obj2)) ＠＠ -530,7 +530,7 ＠＠ } else if (FIXNUMP (obj1) && MARKERP (obj2)) { - const Bytebpos pos2 = byte_marker_position (obj2); + const Bytebpos pos2 = marker_byte_position (obj2); const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2); if (XREALFIXNUM (obj1) >= pos2) ＠＠ -557,10 +557,10 ＠＠ switch (opcode) { case Bmax: - return byte_marker_position (obj1) < byte_marker_position (obj2) + return marker_byte_position (obj1) < marker_byte_position (obj2) ? obj2 : obj1; case Bmin: - return byte_marker_position (obj1) > byte_marker_position (obj2) + return marker_byte_position (obj1) > marker_byte_position (obj2) ? obj2 : obj1; default: obj1 = make_fixnum (marker_position (obj1)); ＠＠ -722,12 +722,12 ＠＠ { if (opcode == Bmax) { - return byte_marker_position (obj1) < byte_marker_position (obj2) + return marker_byte_position (obj1) < marker_byte_position (obj2) ? obj2 : obj1; } else if (opcode == Bmin) { - return byte_marker_position (obj1) > byte_marker_position (obj2) + return marker_byte_position (obj1) > marker_byte_position (obj2) ? obj2 : obj1; } /* Otherwise, convert to a fixnum in the normal way. */ diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/callint.c --- a/src/callint.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/callint.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -232,7 +232,7 ＠＠ if (NILP (tem) || (XBUFFER (tem) != current_buffer)) invalid_operation ("The mark is not set now", Qunbound); - return byte_marker_position (current_buffer->mark); + return marker_byte_position (current_buffer->mark); } static Lisp_Object diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/data.c --- a/src/data.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/data.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -871,8 +871,8 ＠＠ break; \ BIGFLOAT_CASE (op) \ case LAZY_MARKER_T: \ - if (!(byte_marker_position (obj1) c_op \ - byte_marker_position (obj2))) \ + if (!(marker_byte_position (obj1) c_op \ + marker_byte_position (obj2))) \ return Qnil; \ break; \ } \ ＠＠ -2474,8 +2474,8 ＠＠ switch (promote_args_lazy (args + maxindex, args + i)) { case LAZY_MARKER_T: - if (byte_marker_position (args[maxindex]) - < byte_marker_position (args[i])) + if (marker_byte_position (args[maxindex]) + < marker_byte_position (args[i])) maxindex = i; break; case LAZY_FIXNUM_T: ＠＠ -2534,8 +2534,8 ＠＠ if (MARKERP (obj2) && (XMARKER (max_so_far)->buffer == XMARKER (obj2)->buffer)) { - if (byte_marker_position (max_so_far) - < byte_marker_position (obj2)) + if (marker_byte_position (max_so_far) + < marker_byte_position (obj2)) { max_so_far = obj2; } ＠＠ -2606,8 +2606,8 ＠＠ switch (promote_args_lazy (args + minindex, args + i)) { case LAZY_MARKER_T: - if (byte_marker_position (args[minindex]) - > byte_marker_position (args[i])) + if (marker_byte_position (args[minindex]) + > marker_byte_position (args[i])) minindex = i; break; case LAZY_FIXNUM_T: ＠＠ -2667,8 +2667,8 ＠＠ if (MARKERP (obj2) && (XMARKER (min_so_far)->buffer == XMARKER (obj2)->buffer)) { - if (byte_marker_position (min_so_far) - > byte_marker_position (obj2)) + if (marker_byte_position (min_so_far) + > marker_byte_position (obj2)) { min_so_far = obj2; } diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/editfns.c --- a/src/editfns.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/editfns.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -204,7 +204,7 ＠＠ { invalid_operation ("There is no region now", Qunbound); } - if (!!(BYTE_BUF_PT (b) < byte_marker_position (b->mark)) == !!beginningp) + if (!!(BYTE_BUF_PT (b) < marker_byte_position (b->mark)) == !!beginningp) return make_fixnum (BUF_PT (b)); else return Fmarker_position (b->mark); ＠＠ -431,7 +431,7 ＠＠ (buffer)) { struct buffer *b = decode_buffer (buffer, 1); - return set_byte_marker_position (Fmake_marker (), BYTE_BUF_BEGV (b), + return set_marker_byte_position (Fmake_marker (), BYTE_BUF_BEGV (b), wrap_buffer (b)); } ＠＠ -456,7 +456,7 ＠＠ (buffer)) { struct buffer *b = decode_buffer (buffer, 1); - return set_byte_marker_position (Fmake_marker (), BYTE_BUF_ZV (b), + return set_marker_byte_position (Fmake_marker (), BYTE_BUF_ZV (b), wrap_buffer (b)); } ＠＠ -2147,8 +2147,8 ＠＠ But that was clearly before the advent of marker-insertion-type. --ben */ - set_byte_marker_position (bottom, BYTE_BUF_BEGV (buf), wrap_buffer (buf)); - set_byte_marker_position (top, BYTE_BUF_ZV (buf), wrap_buffer (buf)); + set_marker_byte_position (bottom, BYTE_BUF_BEGV (buf), wrap_buffer (buf)); + set_marker_byte_position (top, BYTE_BUF_ZV (buf), wrap_buffer (buf)); Fset_marker_insertion_type (top, Qt); return noseeum_cons (wrap_buffer (buf), noseeum_cons (bottom, top)); ＠＠ -2165,8 +2165,8 ＠＠ /* someone could have killed the buffer in the meantime ... */ if (BUFFER_LIVE_P (buf)) { - Bytebpos byte_start = byte_marker_position (XCAR (markers)); - Bytebpos byte_end = byte_marker_position (XCDR (markers)); + Bytebpos byte_start = marker_byte_position (XCAR (markers)); + Bytebpos byte_end = marker_byte_position (XCDR (markers)); Bytebpos clipped; if (BYTE_BUF_BEGV (buf) != byte_start) diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/extents.h --- a/src/extents.h Sun Mar 10 17:24:04 2019 +0000 +++ b/src/extents.h Sun Mar 10 18:02:36 2019 +0000 ＠＠ -221,7 +221,7 ＠＠ case lrecord_type_buffer: return BYTE_BUF_PT (XBUFFER (stream)); case lrecord_type_marker: - return byte_marker_position (stream); + return marker_byte_position (stream); } } return -1; diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/fileio.c --- a/src/fileio.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/fileio.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -193,7 +193,7 ＠＠ static Lisp_Object restore_point_unwind (Lisp_Object point_marker) { - BYTE_BUF_SET_PT (current_buffer, byte_marker_position (point_marker)); + BYTE_BUF_SET_PT (current_buffer, marker_byte_position (point_marker)); return Fset_marker (point_marker, Qnil, Qnil); } diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/line-number.c --- a/src/line-number.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/line-number.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -134,7 +134,7 ＠＠ at point, which is way losing. Isn't there a way to make a marker impervious to Finsert_before_markers()?? Maybe I should convert the code to use extents. */ - if (byte_marker_position (XCAR (ring[i])) >= pos) + if (marker_byte_position (XCAR (ring[i])) >= pos) { /* Get the marker out of the way. */ Fset_marker (XCAR (ring[i]), Qnil, Qnil); ＠＠ -216,7 +216,7 ＠＠ /* Find the ring entry closest to POS, if it is closer than BEG. */ for (i = 0; i < LINE_NUMBER_RING_SIZE && CONSP (ring[i]); i++) { - Bytebpos newpos = byte_marker_position (XCAR (ring[i])); + Bytebpos newpos = marker_byte_position (XCAR (ring[i])); Bytecount howfar = newpos - pos; if (howfar < 0) howfar = -howfar; ＠＠ -245,7 +245,7 ＠＠ ring[i] = ring[i - 1]; /* ...and update it. */ - ring[0] = Fcons (set_byte_marker_position (Fmake_marker (), pos, + ring[0] = Fcons (set_marker_byte_position (Fmake_marker (), pos, wrap_buffer (b)), make_fixnum (line)); } diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/lisp.h --- a/src/lisp.h Sun Mar 10 17:24:04 2019 +0000 +++ b/src/lisp.h Sun Mar 10 18:02:36 2019 +0000 ＠＠ -5702,8 +5702,8 ＠＠ EXFUN (Fset_marker, 3); EXFUN (Fset_marker_insertion_type, 2); -Bytebpos byte_marker_position (Lisp_Object); Charbpos marker_position (Lisp_Object); +Bytebpos marker_byte_position (Lisp_Object); /* Set the byte position of MARKER, a marker object, to BYTENO in BUFFER. MARKER must be a marker object, BUFFER must be a valid buffer, and ＠＠ -5711,7 +5711,7 ＠＠ BUFFER's point marker. Values for MARKER, BYTENO, and BUFFER are checked only if ERROR_CHECK_STRUCTURES is defined, and cause an assertion failure if out of range, so callers need to check values themselves. */ -Lisp_Object set_byte_marker_position (Lisp_Object marker, Bytebpos byteno, +Lisp_Object set_marker_byte_position (Lisp_Object marker, Bytebpos byteno, Lisp_Object buffer); /* No set_marker_position (); use Fset_marker (). */ diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/lread.c --- a/src/lread.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/lread.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -264,14 +264,14 ＠＠ else if (MARKERP (readcharfun)) { Ichar c; - Bytebpos mpos = byte_marker_position (readcharfun); + Bytebpos mpos = marker_byte_position (readcharfun); struct buffer *inbuffer = XMARKER (readcharfun)->buffer; if (mpos >= BYTE_BUF_ZV (inbuffer)) return -1; c = BYTE_BUF_FETCH_CHAR (inbuffer, mpos); INC_BYTEBPOS (inbuffer, mpos); - set_byte_marker_position (readcharfun, mpos, wrap_buffer (inbuffer)); + set_marker_byte_position (readcharfun, mpos, wrap_buffer (inbuffer)); return c; } else ＠＠ -311,12 +311,12 ＠＠ } else if (MARKERP (readcharfun)) { - Bytebpos mpos = byte_marker_position (readcharfun); + Bytebpos mpos = marker_byte_position (readcharfun); struct buffer *buf = XMARKER (readcharfun)->buffer; DEC_BYTEBPOS (buf, mpos); - set_byte_marker_position (readcharfun, + set_marker_byte_position (readcharfun, /* This is extra-conservative, no code actually unreads without having read anything. */ diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/lstream.c --- a/src/lstream.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/lstream.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -2067,8 +2067,8 ＠＠ if (!BUFFER_LIVE_P (buf)) return 0; /* Fut. */ - start = byte_marker_position (str->start); - end = byte_marker_position (str->end); + start = marker_byte_position (str->start); + end = marker_byte_position (str->end); if (!(stream->flags & LSTR_IGNORE_ACCESSIBLE)) { start = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf), start, ＠＠ -2090,7 +2090,7 ＠＠ *p = '\n'; } - set_byte_marker_position (str->start, end, wrap_buffer (buf)); + set_marker_byte_position (str->start, end, wrap_buffer (buf)); return size; } ＠＠ -2138,16 +2138,16 ＠＠ struct lisp_buffer_stream *str = LISP_BUFFER_STREAM_DATA (stream); struct buffer *buf = XBUFFER (str->buffer); - Bytebpos pos = byte_marker_position (str->orig_start); + Bytebpos pos = marker_byte_position (str->orig_start); if (!BUFFER_LIVE_P (buf)) return -1; /* Fut. */ if (pos > BYTE_BUF_ZV (buf)) pos = BYTE_BUF_ZV (buf); - if (pos < byte_marker_position (str->orig_start)) - pos = byte_marker_position (str->orig_start); - if (MARKERP (str->end) && pos > byte_marker_position (str->end)) - pos = byte_marker_position (str->end); - set_byte_marker_position (str->start, pos, wrap_buffer (buf)); + if (pos < marker_byte_position (str->orig_start)) + pos = marker_byte_position (str->orig_start); + if (MARKERP (str->end) && pos > marker_byte_position (str->end)) + pos = marker_byte_position (str->end); + set_marker_byte_position (str->start, pos, wrap_buffer (buf)); return 0; } diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/marker.c --- a/src/marker.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/marker.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -355,7 +355,7 ＠＠ BYTENO must be a valid byte position within BUFFER. MARKER may not be BUFFER's point marker. */ Lisp_Object -set_byte_marker_position (Lisp_Object marker, Bytebpos byteno, +set_marker_byte_position (Lisp_Object marker, Bytebpos byteno, Lisp_Object buffer) { #ifdef ERROR_CHECK_STRUCTURES ＠＠ -447,8 +447,19 ＠＠ marker->buffer = 0; } +Charbpos +marker_position (Lisp_Object marker) +{ + struct buffer *buf = XMARKER (marker)->buffer; + + if (!buf) + invalid_argument ("Marker does not point anywhere", Qunbound); + + return bytebpos_to_charbpos (buf, marker_byte_position (marker)); +} + Bytebpos -byte_marker_position (Lisp_Object marker) +marker_byte_position (Lisp_Object marker) { Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; ＠＠ -468,17 +479,6 ＠＠ return pos; } -Charbpos -marker_position (Lisp_Object marker) -{ - struct buffer *buf = XMARKER (marker)->buffer; - - if (!buf) - invalid_argument ("Marker does not point anywhere", Qunbound); - - return bytebpos_to_charbpos (buf, byte_marker_position (marker)); -} - static Lisp_Object copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum) { diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/print.c --- a/src/print.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/print.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -490,8 +490,8 ＠＠ doesn't point anywhere. */ marker_position (function), nonreloc, reloc, offset, len, -1, 0); - set_byte_marker_position (function, - byte_marker_position (function) + len, + set_marker_byte_position (function, + marker_byte_position (function) + len, wrap_buffer (XMARKER (function)->buffer)); UNGCPRO; return len; /* We will have errored on failure. */ diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/redisplay-output.c --- a/src/redisplay-output.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/redisplay-output.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -1028,7 +1028,7 ＠＠ { w->last_point_x[CURRENT_DISP] = 0; w->last_point_y[CURRENT_DISP] = y; - set_byte_marker_position (w->last_point[CURRENT_DISP], + set_marker_byte_position (w->last_point[CURRENT_DISP], BYTE_BUF_BEG (w->buffer), w->buffer); rb = Dynarr_begin (db->runes); rb->cursor_type = CURSOR_ON; ＠＠ -2315,11 +2315,11 ＠＠ w->last_modified[CURRENT_DISP] = w->last_modified[DESIRED_DISP]; w->last_facechange[CURRENT_DISP] = w->last_facechange[DESIRED_DISP]; - set_byte_marker_position (w->last_point[CURRENT_DISP], - byte_marker_position (w->last_point[DESIRED_DISP]), + set_marker_byte_position (w->last_point[CURRENT_DISP], + marker_byte_position (w->last_point[DESIRED_DISP]), w->buffer); - set_byte_marker_position (w->last_start[CURRENT_DISP], - byte_marker_position (w->last_start[DESIRED_DISP]), + set_marker_byte_position (w->last_start[CURRENT_DISP], + marker_byte_position (w->last_start[DESIRED_DISP]), w->buffer); /* We don't bother updating the vertical scrollbars here. This ＠＠ -2491,19 +2491,19 ＠＠ } w->window_end_pos[CURRENT_DISP] = w->window_end_pos[DESIRED_DISP]; - set_byte_marker_position (w->start[CURRENT_DISP], - byte_marker_position (w->start[DESIRED_DISP]), + set_marker_byte_position (w->start[CURRENT_DISP], + marker_byte_position (w->start[DESIRED_DISP]), w->buffer); - set_byte_marker_position (w->pointm[CURRENT_DISP], - byte_marker_position (w->pointm[DESIRED_DISP]), + set_marker_byte_position (w->pointm[CURRENT_DISP], + marker_byte_position (w->pointm[DESIRED_DISP]), w->buffer); w->last_modified[CURRENT_DISP] = w->last_modified[DESIRED_DISP]; w->last_facechange[CURRENT_DISP] = w->last_facechange[DESIRED_DISP]; - set_byte_marker_position (w->last_start[CURRENT_DISP], - byte_marker_position (w->last_start[DESIRED_DISP]), + set_marker_byte_position (w->last_start[CURRENT_DISP], + marker_byte_position (w->last_start[DESIRED_DISP]), w->buffer); - set_byte_marker_position (w->last_point[CURRENT_DISP], - byte_marker_position (w->last_point[DESIRED_DISP]), + set_marker_byte_position (w->last_point[CURRENT_DISP], + marker_byte_position (w->last_point[DESIRED_DISP]), w->buffer); w->last_point_x[CURRENT_DISP] = w->last_point_x[DESIRED_DISP]; w->last_point_y[CURRENT_DISP] = w->last_point_y[DESIRED_DISP]; diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/redisplay.c --- a/src/redisplay.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/redisplay.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -959,7 +959,7 ＠＠ if (MARKERP (Voverlay_arrow_position) && EQ (w->buffer, Fmarker_buffer (Voverlay_arrow_position)) - && byte_start_pos == byte_marker_position (Voverlay_arrow_position) + && byte_start_pos == marker_byte_position (Voverlay_arrow_position) && (STRINGP (Voverlay_arrow_string) || GLYPHP (Voverlay_arrow_string))) { ＠＠ -2257,7 +2257,7 ＠＠ } else if (w == XWINDOW (FRAME_SELECTED_WINDOW (f))) { - data.byte_cursor_charpos = byte_marker_position (w->pointm[type]); + data.byte_cursor_charpos = marker_byte_position (w->pointm[type]); data.cursor_type = CURSOR_ON; } else ＠＠ -5814,7 +5814,7 ＠＠ /* If the cursor is moved we attempt to update it. If we succeed we go ahead and proceed with the optimization attempt. */ if (!EQ (Fmarker_buffer (w->last_point[CURRENT_DISP]), w->buffer) - || byte_pointm != byte_marker_position (w->last_point[CURRENT_DISP])) + || byte_pointm != marker_byte_position (w->last_point[CURRENT_DISP])) { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); ＠＠ -5876,7 +5876,7 ＠＠ if (line > dla_end) { if (EQ (Fmarker_buffer (w->last_point[CURRENT_DISP]), w->buffer) - && byte_pointm == byte_marker_position (w->last_point[CURRENT_DISP])) + && byte_pointm == marker_byte_position (w->last_point[CURRENT_DISP])) return 1; else return 0; ＠＠ -5892,7 +5892,7 ＠＠ w->last_modified[DESIRED_DISP] = make_fixnum (BUF_MODIFF (b)); w->last_facechange[DESIRED_DISP] = make_fixnum (BUF_FACECHANGE (b)); Fset_marker (w->last_start[DESIRED_DISP], make_fixnum (startp), w->buffer); - set_byte_marker_position (w->last_point[DESIRED_DISP], + set_marker_byte_position (w->last_point[DESIRED_DISP], min (BYTE_BUF_Z (XBUFFER (w->buffer)), max (BYTE_BUF_BEG (XBUFFER (w->buffer)), byte_pointm)), w->buffer); ＠＠ -6359,7 +6359,7 ＠＠ old_pointm = noseeum_copy_marker (selected_globally ? b->point_marker : w->pointm[CURRENT_DISP], Qnil); pointm = BUF_BEG (b); - set_byte_marker_position (w->pointm[DESIRED_DISP], BYTE_BUF_BEG (b), + set_marker_byte_position (w->pointm[DESIRED_DISP], BYTE_BUF_BEG (b), wrap_buffer (b)); } else ＠＠ -6367,20 +6367,20 ＠＠ if (selected_globally) { pointm = BUF_PT (b); - set_byte_marker_position (w->pointm[DESIRED_DISP], BYTE_BUF_PT (b), + set_marker_byte_position (w->pointm[DESIRED_DISP], BYTE_BUF_PT (b), the_buffer); } else { Bytebpos byte_pointm - = byte_marker_position (w->pointm[CURRENT_DISP]); + = marker_byte_position (w->pointm[CURRENT_DISP]); if (byte_pointm < BYTE_BUF_BEGV (b)) byte_pointm = BYTE_BUF_BEGV (b); else if (byte_pointm > BYTE_BUF_ZV (b)) byte_pointm = BYTE_BUF_ZV (b); - set_byte_marker_position (w->pointm[DESIRED_DISP], byte_pointm, + set_marker_byte_position (w->pointm[DESIRED_DISP], byte_pointm, the_buffer); pointm = bytebpos_to_charbpos (b, byte_pointm); } ＠＠ -6432,12 +6432,12 ＠＠ old_startp = noseeum_copy_marker (w->start[CURRENT_DISP], Qnil); startp = BUF_BEG (b); - set_byte_marker_position (w->start[DESIRED_DISP], BYTE_BUF_BEG (b), + set_marker_byte_position (w->start[DESIRED_DISP], BYTE_BUF_BEG (b), the_buffer); } else { - Bytebpos byte_startp = byte_marker_position (w->start[CURRENT_DISP]); + Bytebpos byte_startp = marker_byte_position (w->start[CURRENT_DISP]); if (byte_startp < BYTE_BUF_BEGV (b)) { byte_startp = BYTE_BUF_BEGV (b); ＠＠ -6453,7 +6453,7 ＠＠ startp = bytebpos_to_charbpos (b, byte_startp); } - set_byte_marker_position (w->start[DESIRED_DISP], byte_startp, + set_marker_byte_position (w->start[DESIRED_DISP], byte_startp, the_buffer); } ＠＠ -6503,7 +6503,7 ＠＠ && !truncation_changed /* check whether start is really at the beginning of a line GE */ && (!w->start_at_line_beg || - byte_beginning_of_line_p (b, byte_marker_position + byte_beginning_of_line_p (b, marker_byte_position (w->start[DESIRED_DISP]))) ) { ＠＠ -6581,11 +6581,11 ＠＠ up with a blank window. */ else if (((w->start_at_line_beg || MINI_WINDOW_P (w)) && !(byte_beginning_of_line_p - (b, byte_marker_position (w->start[DESIRED_DISP])))) + (b, marker_byte_position (w->start[DESIRED_DISP])))) || (pointm == startp && EQ (Fmarker_buffer (w->last_start[CURRENT_DISP]), w->buffer) && - byte_marker_position (w->start[DESIRED_DISP]) - < byte_marker_position (w->last_start[CURRENT_DISP])) + marker_byte_position (w->start[DESIRED_DISP]) + < marker_byte_position (w->last_start[CURRENT_DISP])) || (startp == BUF_ZV (b))) { startp = regenerate_window_point_center (w, pointm, DESIRED_DISP); ＠＠ -7384,7 +7384,7 ＠＠ { Bytebpos pt = (w == XWINDOW (Fselected_window (Qnil))) ? BYTE_BUF_PT (b) - : byte_marker_position (w->pointm[type]); + : marker_byte_position (w->pointm[type]); Charcount col = column_at_point (b, pt, 1) + !!column_number_start_at_one; Ibyte buf[DECIMAL_PRINT_SIZE (col)]; ＠＠ -7412,7 +7412,7 ＠＠ case 'l': { Bytebpos pos = (w == XWINDOW (Fselected_window (Qnil))) - ? BYTE_BUF_PT (b) : byte_marker_position (w->pointm[type]); + ? BYTE_BUF_PT (b) : marker_byte_position (w->pointm[type]); Charcount line = buffer_line_number (b, pos, 1, 1) + 1; Ibyte buf[DECIMAL_PRINT_SIZE (line)]; ＠＠ -7509,7 +7509,7 ＠＠ /* print percent of buffer above top of window, or Top, Bot or All */ case 'p': { - Bytebpos pos = byte_marker_position (w->start[type]); + Bytebpos pos = marker_byte_position (w->start[type]); /* This had better be while the desired lines are being done. */ if (w->window_end_pos[type] <= BUF_Z (b) - BUF_ZV (b)) ＠＠ -7554,7 +7554,7 ＠＠ if (botpos >= BUF_ZV (b)) { - if (byte_marker_position (w->start[type]) <= BYTE_BUF_BEGV (b)) + if (marker_byte_position (w->start[type]) <= BYTE_BUF_BEGV (b)) str = "All"; else str = "Bottom"; ＠＠ -7562,7 +7562,7 ＠＠ else { EMACS_UINT bytes, total = BYTE_BUF_ZV (b) - BYTE_BUF_BEGV (b); - Bytebpos toppos = byte_marker_position (w->start[type]); + Bytebpos toppos = marker_byte_position (w->start[type]); int percent; Ibyte buf[DECIMAL_PRINT_SIZE (percent)]; diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/syntax.c --- a/src/syntax.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/syntax.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -605,8 +605,8 ＠＠ struct syntax_cache *cache = XBUFFER (object)->syntax_cache; Bytexpos extent_start = extent_endpoint_byte (extent, 0); Bytexpos extent_end = extent_endpoint_byte (extent, 1); - Bytexpos cache_start = byte_marker_position (cache->start); - Bytexpos cache_end = byte_marker_position (cache->end); + Bytexpos cache_start = marker_byte_position (cache->start); + Bytexpos cache_end = marker_byte_position (cache->end); /* If the extent is entirely before or entirely after the cache range, it doesn't overlap. Otherwise, invalidate the range. */ if (!(extent_end < cache_start || extent_start > cache_end)) diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/text.c --- a/src/text.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/text.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -4252,7 +4252,7 ＠＠ Bytebpos ind; Bytebpos min_allowed, max_allowed; - ind = byte_marker_position (pos); + ind = marker_byte_position (pos); min_allowed = flags & GB_ALLOW_PAST_ACCESSIBLE ? BYTE_BUF_BEG (b) : BYTE_BUF_BEGV (b); diff -r 5d1f8a39a8d0 -r 9061f6baa930 src/window.c --- a/src/window.c Sun Mar 10 17:24:04 2019 +0000 +++ b/src/window.c Sun Mar 10 18:02:36 2019 +0000 ＠＠ -2000,7 +2000,7 ＠＠ /* WTF is the above supposed to mean? GE */ w->start_at_line_beg = byte_beginning_of_line_p (XBUFFER (w->buffer), - byte_marker_position (w->start[CURRENT_DISP])); + marker_byte_position (w->start[CURRENT_DISP])); if (NILP (noforce)) w->force_start = 1; w->redo_modeline = 1; ＠＠ -2082,8 +2082,8 ＠＠ else { set_extent_endpoints (XEXTENT (saved_point), - byte_marker_position (w->pointm[CURRENT_DISP]), - byte_marker_position (w->pointm[CURRENT_DISP]), + marker_byte_position (w->pointm[CURRENT_DISP]), + marker_byte_position (w->pointm[CURRENT_DISP]), buf); } ＠＠ -2099,8 +2099,8 ＠＠ } set_extent_endpoints (XEXTENT (saved_window_start), - byte_marker_position (w->start[CURRENT_DISP]), - byte_marker_position (w->start[CURRENT_DISP]), + marker_byte_position (w->start[CURRENT_DISP]), + marker_byte_position (w->start[CURRENT_DISP]), buf); /* last_window_start records the start position that this buffer ＠＠ -3359,7 +3359,7 ＠＠ w->buffer); w->start_at_line_beg = byte_beginning_of_line_p - (b, byte_marker_position (w->start[CURRENT_DISP])); + (b, marker_byte_position (w->start[CURRENT_DISP])); } /* We need to do this, so that the window-scroll-functions get called. */ ＠＠ -3815,7 +3815,7 ＠＠ since it always occurred when the window was selected, meaning its value of point was ignored in favor of the buffer's; but it tripped an assert() in unshow_buffer(). */ - set_byte_marker_position (w->pointm[CURRENT_DISP], bpoint, buffer); + set_marker_byte_position (w->pointm[CURRENT_DISP], bpoint, buffer); if (EQ (wrap_window (w), Fselected_window (Qnil))) { BYTE_BUF_SET_PT (XBUFFER (buffer), bpoint); ＠＠ -3845,8 +3845,8 ＠＠ bstart = BYTE_BUF_BEGV (XBUFFER (buffer)); } - set_byte_marker_position (w->start[CURRENT_DISP], bstart, buffer); - set_byte_marker_position (w->sb_point, bstart, buffer); + set_marker_byte_position (w->start[CURRENT_DISP], bstart, buffer); + set_marker_byte_position (w->sb_point, bstart, buffer); /* set start_at_line_beg correctly. GE */ w->start_at_line_beg = byte_beginning_of_line_p (XBUFFER (buffer), bstart); ＠＠ -4690,7 +4690,7 ＠＠ Fset_marker (w->start[CURRENT_DISP], point, w->buffer); w->start_at_line_beg = byte_beginning_of_line_p - (b, byte_marker_position (w->start[CURRENT_DISP])); + (b, marker_byte_position (w->start[CURRENT_DISP])); WINDOW_TEXT_TOP_CLIP (w) = 0; MARK_WINDOWS_CHANGED (w); } ＠＠ -4792,7 +4792,7 ＠＠ w->force_start = 1; w->start_at_line_beg = byte_beginning_of_line_p - (b, byte_marker_position (w->start[CURRENT_DISP])); + (b, marker_byte_position (w->start[CURRENT_DISP])); MARK_WINDOWS_CHANGED (w); if (!point_would_be_visible (w, startp, XFIXNUM (point), 0)) ＠＠ -4844,7 +4844,7 ＠＠ w->force_start = 1; w->start_at_line_beg = byte_beginning_of_line_p - (b, byte_marker_position (w->start[CURRENT_DISP])); + (b, marker_byte_position (w->start[CURRENT_DISP])); MARK_WINDOWS_CHANGED (w); /* #### Scroll back by less than a line. This code was ＠＠ -4909,7 +4909,7 ＠＠ w->force_start = 1; w->start_at_line_beg = byte_beginning_of_line_p - (b, byte_marker_position (w->start[CURRENT_DISP])); + (b, marker_byte_position (w->start[CURRENT_DISP])); MARK_WINDOWS_CHANGED (w); if (!point_would_be_visible (w, startp, XFIXNUM (point), 0)) ＠＠ -5089,7 +5089,7 ＠＠ w->start_at_line_beg = byte_beginning_of_line_p (b, - byte_marker_position (w->start[CURRENT_DISP])); + marker_byte_position (w->start[CURRENT_DISP])); w->force_start = 1; MARK_WINDOWS_CHANGED (w); return Qnil; ＠＠ -5195,7 +5195,7 ＠＠ w->buffer); w->start_at_line_beg = byte_beginning_of_line_p - (b, byte_marker_position (w->start[CURRENT_DISP])); + (b, marker_byte_position (w->start[CURRENT_DISP])); w->force_start = 1; } else -- ‘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 modiff, save_modiff, other buffer variables into EMACS_INT. 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1552238644 0 # Sun Mar 10 17:24:04 2019 +0000 # Node ID 5d1f8a39a8d09a49b87b25c7b27b09fa8b3059c0 # Parent 5aaa9025873317ac1c3054debfddb90c77168838 Make modiff, save_modiff, other buffer variables into EMACS_INT. src/ChangeLog addition: 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> Make the modiff, save_modiff, face_change, auto_save_modified buffer slots into EMACS_INTs. Supply and use an arithcompare function for all of them that pays attention to the fact that they wrap around. * buffer.c (Fbuffer_modified_tick): Caution regarding ordinal comparisons with the result of this function. Use make_integer, not make_fixnum, there is no guarantee a fixnum will have the bit width to represent the complete value. * buffer.c (Fbuffer_modified_p): * buffer.c (Fset_buffer_modified_p): * buffer.c (Fkill_buffer): Use buf_tick_arithcompare() in these functions. * buffer.h: * buffer.h (struct buffer_text): * buffer.h (struct buffer): Use EMACS_INT as appropriate in these structures. * buffer.h (buf_tick_arithcompare): New. Compare two buffer tick values, heuristically comparing for wraparound. * fileio.c (Fdo_auto_save): Use buf_tick_arithcompare() as appropriate. * filelock.c (unlock_all_files): * filelock.c (Flock_buffer): * filelock.c (Funlock_buffer): * filelock.c (unlock_buffer): Use buf_tick_arithcompare() as appropriate in these functions. * insdel.c (signal_before_change): * insdel.c (prepare_to_modify_buffer): Use buf_tick_arithcompare() as appropriate in this file. * redisplay.c (regenerate_window_extents_only_changed): * redisplay.c (redisplay_window): * redisplay.c (decode_mode_spec): * redisplay.c (validate_line_start_cache): Use buf_tick_arithcompare() as appropriate in this file. * undo.c (undo_prelude): Ditto. * window.c (Fmove_to_window_line): Ditto. diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/ChangeLog --- a/src/ChangeLog Sun Mar 10 14:06:13 2019 +0000 +++ b/src/ChangeLog Sun Mar 10 17:24:04 2019 +0000 ＠＠ -1,3 +1,45 ＠＠ +2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> + + Make the modiff, save_modiff, face_change, auto_save_modified + buffer slots into EMACS_INTs. + Supply and use an arithcompare function for all of them that pays + attention to the fact that they wrap around. + * buffer.c (Fbuffer_modified_tick): + Caution regarding ordinal comparisons with the result of this + function. + Use make_integer, not make_fixnum, there is no guarantee a fixnum + will have the bit width to represent the complete value. + * buffer.c (Fbuffer_modified_p): + * buffer.c (Fset_buffer_modified_p): + * buffer.c (Fkill_buffer): + Use buf_tick_arithcompare() in these functions. + * buffer.h: + * buffer.h (struct buffer_text): + * buffer.h (struct buffer): + Use EMACS_INT as appropriate in these structures. + * buffer.h (buf_tick_arithcompare): New. + Compare two buffer tick values, heuristically comparing for + wraparound. + * fileio.c (Fdo_auto_save): + Use buf_tick_arithcompare() as appropriate. + * filelock.c (unlock_all_files): + * filelock.c (Flock_buffer): + * filelock.c (Funlock_buffer): + * filelock.c (unlock_buffer): + Use buf_tick_arithcompare() as appropriate in these functions. + * insdel.c (signal_before_change): + * insdel.c (prepare_to_modify_buffer): + Use buf_tick_arithcompare() as appropriate in this file. + * redisplay.c (regenerate_window_extents_only_changed): + * redisplay.c (redisplay_window): + * redisplay.c (decode_mode_spec): + * redisplay.c (validate_line_start_cache): + Use buf_tick_arithcompare() as appropriate in this file. + * undo.c (undo_prelude): + Ditto. + * window.c (Fmove_to_window_line): + Ditto. + 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> * buffer.c (complex_vars_of_buffer): diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/buffer.c --- a/src/buffer.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/buffer.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -973,7 +973,8 ＠＠ { struct buffer *buf = decode_buffer (buffer, 0); - return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; + return buf_tick_arithcompare (BUF_SAVE_MODIFF (buf), BUF_MODIFF (buf)) < 0 + ? Qt : Qnil; } DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, 1, 2, 0, /* ＠＠ -993,7 +994,8 ＠＠ Lisp_Object fn = buf->file_truename; if (!NILP (fn)) { - int already = BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf); + Boolint already = buf_tick_arithcompare (BUF_SAVE_MODIFF (buf), + BUF_MODIFF (buf)) < 0; if (already == NILP (flag)) { int count = specpdl_depth (); ＠＠ -1027,14 +1029,15 ＠＠ DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, 0, 1, 0, /* Return BUFFER's tick counter, incremented for each change in text. Each buffer has a tick counter which is incremented each time the text in -that buffer is changed. It wraps around occasionally. +that buffer is changed. It wraps around occasionally, and so user +code needs to be careful about ordinal comparisons. No argument or nil as argument means use current buffer as BUFFER. */ (buffer)) { struct buffer *buf = decode_buffer (buffer, 0); - return make_fixnum (BUF_MODIFF (buf)); + return make_integer (BUF_MODIFF (buf)); } DEFUN ("rename-buffer", Frename_buffer, 1, 2, ＠＠ -1245,7 +1248,7 ＠＠ /* Query if the buffer is still modified. */ if (INTERACTIVE && !NILP (b->filename) - && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) + && buf_tick_arithcompare (BUF_MODIFF (b), BUF_SAVE_MODIFF (b)) > 0) { Lisp_Object killp; GCPRO1 (buf); diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/buffer.h --- a/src/buffer.h Sun Mar 10 14:06:13 2019 +0000 +++ b/src/buffer.h Sun Mar 10 17:24:04 2019 +0000 ＠＠ -86,12 +86,12 ＠＠ Charbpos bufz; /* Equivalent as a Charbpos. */ Bytecount gap_size;/* Size of buffer's gap */ Bytecount end_gap_size;/* Size of buffer's end gap */ - long modiff; /* This counts buffer-modification events + EMACS_INT modiff; /* This counts buffer-modification events for this buffer. It is incremented for each such event, and never otherwise changed. */ - long save_modiff; /* Previous value of modiff, as of last - time buffer visited or saved a file. */ + EMACS_INT save_modiff; /* Previous value of modiff, as of last + time buffer visited or saved a file. */ #ifdef MULE ＠＠ -172,8 +172,8 ＠＠ Bytebpos zv; /* Index of end of accessible range. */ Charbpos bufzv; /* Equivalent as a Charbpos. */ - int face_change; /* This is set when a change in how the text should - be displayed (e.g., font, color) is made. */ + EMACS_INT face_change; /* This is set when a change in how the text should + be displayed (e.g., font, color) is made. */ /* Whether buffer specific face is specified. */ int buffer_local_face_property; ＠＠ -248,7 +248,7 ＠＠ time_t modtime; /* the value of text->modiff at the last auto-save. */ - long auto_save_modified; + EMACS_INT auto_save_modified; /* The time at which we detected a failure to auto-save, Or -1 if we didn't have a failure. */ ＠＠ -1133,6 +1133,21 ＠＠ /* Modification count */ #define BUF_MODIFF(buf) ((buf)->text->modiff) +/* The modification count wraps around, use the following to compare, which + uses the same approach as Fevent_timestamp_lessp(). */ +DECLARE_INLINE_HEADER ( +int +buf_tick_arithcompare (EMACS_INT val1, EMACS_INT val2) +) +{ + if (val1 < val2 && ((val2 - val1) < (EMACS_INT) ((~(EMACS_UINT)(0) >> 2)))) + { + return -1; + } + + return val1 != val2; +} + /* Saved modification count */ #define BUF_SAVE_MODIFF(buf) ((buf)->text->save_modiff) diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/fileio.c --- a/src/fileio.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/fileio.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -4178,9 +4178,12 ＠＠ and file changed since last auto save and file changed since last real save. */ if (STRINGP (b->auto_save_file_name) - && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) - && b->auto_save_modified < BUF_MODIFF (b) - /* -1 means we've turned off autosaving for a while--see below. */ + && buf_tick_arithcompare (BUF_SAVE_MODIFF (b), + BUF_MODIFF (b)) < 0 + && buf_tick_arithcompare (b->auto_save_modified, + BUF_MODIFF (b)) < 0 + /* -1 means we've turned off autosaving for a while--see + below. */ && XFIXNUM (b->saved_size) >= 0 && (do_handled_files || NILP (Ffind_file_name_handler (b->auto_save_file_name, diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/filelock.c --- a/src/filelock.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/filelock.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -405,7 +405,8 ＠＠ for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { struct buffer *b = XBUFFER (XCDR (XCAR (tail))); - if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) + if (STRINGP (b->file_truename) + && buf_tick_arithcompare (BUF_SAVE_MODIFF (b), BUF_MODIFF (b)) < 0) unlock_file (b->file_truename); } } ＠＠ -420,7 +421,8 ＠＠ if (NILP (file)) file = current_buffer->file_truename; CHECK_STRING (file); - if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) + if (buf_tick_arithcompare (BUF_SAVE_MODIFF (current_buffer), + BUF_MODIFF (current_buffer)) < 0 && !NILP (file)) lock_file (file); return Qnil; ＠＠ -437,7 +439,8 ＠＠ mean nasty things with pointy teeth. If you call this make sure you protect things right. */ - if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) + if (buf_tick_arithcompare (BUF_SAVE_MODIFF (current_buffer), + BUF_MODIFF (current_buffer)) < 0 && STRINGP (current_buffer->file_truename)) unlock_file (current_buffer->file_truename); return Qnil; ＠＠ -453,7 +456,8 ＠＠ /* dmoore - and can destroy current_buffer and all sorts of other mean nasty things with pointy teeth. If you call this make sure you protect things right. */ - if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) + if (buf_tick_arithcompare (BUF_SAVE_MODIFF (buffer), + BUF_MODIFF (buffer)) < 0 && STRINGP (buffer->file_truename)) unlock_file (buffer->file_truename); } diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/insdel.c --- a/src/insdel.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/insdel.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -797,7 +797,8 ＠＠ } /* If buffer is unmodified, run a special hook for that case. */ - if (BUF_SAVE_MODIFF (buf) >= BUF_MODIFF (buf)) + if (buf_tick_arithcompare (BUF_SAVE_MODIFF (buf), BUF_MODIFF (buf)) + > -1) { MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { ＠＠ -979,7 +980,7 ＠＠ buffer = wrap_buffer (buf); GCPRO1 (buffer); if (!NILP (buf->filename) && lockit && - BUF_SAVE_MODIFF (buf) >= BUF_MODIFF (buf)) + buf_tick_arithcompare (BUF_SAVE_MODIFF (buf), BUF_MODIFF (buf)) >= 0) { #ifdef CLASH_DETECTION if (!NILP (buf->file_truename)) diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/redisplay.c --- a/src/redisplay.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/redisplay.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -5805,7 +5805,8 ＠＠ under which this can happen, but I believe that it is probably a reasonable happening. */ if (!point_visible (w, pointm, CURRENT_DISP) - || XFIXNUM (w->last_modified[CURRENT_DISP]) < BUF_MODIFF (b)) + || buf_tick_arithcompare (XFIXNUM (w->last_modified[CURRENT_DISP]), + BUF_MODIFF (b)) < 0) return 0; byte_pointm = charbpos_to_bytebpos (b, pointm); ＠＠ -6490,8 +6491,10 ＠＠ /* If nothing has changed since the last redisplay, then we just need to make sure that point is still visible. */ - if (XFIXNUM (w->last_modified[CURRENT_DISP]) >= BUF_MODIFF (b) - && XFIXNUM (w->last_facechange[CURRENT_DISP]) >= BUF_FACECHANGE (b) + if (buf_tick_arithcompare (XFIXNUM (w->last_modified[CURRENT_DISP]), + BUF_MODIFF (b)) >= 0 + && buf_tick_arithcompare (w->last_facechange[CURRENT_DISP], + BUF_FACECHANGE (b)) >= 0 && pointm >= startp /* This check is to make sure we restore the minibuffer after a temporary change to the echo area. */ ＠＠ -6604,8 +6607,10 ＠＠ && regenerate_window_incrementally (w, startp, pointm)) { if (f->modeline_changed - || XFIXNUM (w->last_modified[CURRENT_DISP]) < BUF_MODIFF (b) - || XFIXNUM (w->last_facechange[CURRENT_DISP]) < BUF_FACECHANGE (b)) + || buf_tick_arithcompare (XFIXNUM (w->last_modified[CURRENT_DISP]), + BUF_MODIFF (b)) < 0 + || buf_tick_arithcompare (XFIXNUM (w->last_facechange[CURRENT_DISP]), + BUF_FACECHANGE (b)) < 0) regenerate_modeline (w); skip_output = 1; ＠＠ -7457,14 +7462,15 ＠＠ /* print %, * or hyphen, if buffer is read-only, modified or neither */ case '*': str = (!NILP (b->read_only) - ? "%" : ((BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) + ? "%" : (buf_tick_arithcompare (BUF_MODIFF (b), + BUF_SAVE_MODIFF (b)) > 0 ? "*" : "-")); break; /* print * or hyphen -- XEmacs change to allow a buffer to be read-only but still indicate whether it is modified. */ case '+': - str = ((BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) + str = ((buf_tick_arithcompare (BUF_MODIFF (b), BUF_SAVE_MODIFF (b)) > 0) ? "*" : (!NILP (b->read_only) ? "%" ＠＠ -7475,9 +7481,9 ＠＠ modeline-format doc string. */ /* This differs from %* in that it ignores read-only-ness. */ case '&': - str = ((BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) + str = (buf_tick_arithcompare (BUF_MODIFF (b), BUF_SAVE_MODIFF (b)) > 0) ? "*" - : "-"); + : "-"; break; /* print process status */ ＠＠ -7840,7 +7846,8 ＠＠ does redisplay will catch it pretty quickly we no longer invalidate the cache if it is set. This greatly speeds up dragging out regions with the mouse. */ - if (XFIXNUM (w->line_cache_last_updated) < BUF_MODIFF (b) + if (buf_tick_arithcompare (XFIXNUM (w->line_cache_last_updated), + BUF_MODIFF (b)) < 0 || f->faces_changed || f->clip_changed) { diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/undo.c --- a/src/undo.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/undo.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -85,7 +85,7 ＠＠ if (hack_pending_boundary && NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (BUF_MODIFF (b) <= BUF_SAVE_MODIFF (b)) + if (buf_tick_arithcompare (BUF_MODIFF (b), BUF_SAVE_MODIFF (b)) <= 0) { /* Record that an unmodified buffer is about to be changed. Record the file modification date so that when undoing this diff -r 5aaa90258733 -r 5d1f8a39a8d0 src/window.c --- a/src/window.c Sun Mar 10 14:06:13 2019 +0000 +++ b/src/window.c Sun Mar 10 17:24:04 2019 +0000 ＠＠ -5126,8 +5126,10 ＠＠ { int retval; - if (XFIXNUM (w->last_modified[CURRENT_DISP]) >= BUF_MODIFF (b) - && XFIXNUM (w->last_facechange[CURRENT_DISP]) >= BUF_FACECHANGE (b)) + if (buf_tick_arithcompare (XFIXNUM (w->last_modified[CURRENT_DISP]), + BUF_MODIFF (b)) >= 0 + && buf_tick_arithcompare (XFIXNUM (w->last_facechange[CURRENT_DISP]), + BUF_FACECHANGE (b)) >= 0) { new_point = point_at_center (w, CURRENT_DISP, 0, 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] Make buf->modtime a time_t; use lisp_to_time(), make_time() as appropriate. 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1552226773 0 # Sun Mar 10 14:06:13 2019 +0000 # Node ID 5aaa9025873317ac1c3054debfddb90c77168838 # Parent 93f9adafefb31b803e6ed8d5062aa3ce70b46ff4 Make buf->modtime a time_t; use lisp_to_time(), make_time() as appropriate. src/ChangeLog addition: 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> * buffer.c (complex_vars_of_buffer): Document the revised format of the undo list, where the saved modification time is now whatever was supplied by make_time(). * buffer.h (struct buffer): Make modtime and auto_save_failure_time into time_t, not int. * editfns.c (lisp_to_time): Give this a docstring, and declare it as returning a Boolint, for more clarity about what's going on with its return value. * fileio.c: * fileio.c (Fset_visited_file_modtime): Update the time of buf->modtime in this function. * lisp.h: Make lisp_to_time() generally available. * select-gtk.c (symbol_to_gtk_atom): No need to declare lisp_to_time() here, nor the long-obsolete time_to_lisp(). * select-x.c: No need to declare lisp_to_time() here, and we are using lisp_to_uint32_t() anyway, as appropriate for X11. * undo.c (undo_prelude): Just call make_time() here when saving the modification time, don't implement it ourselves. * undo.c (Fprimitive_undo): Use lisp_to_time() here, rather than implementing it ourselves. diff -r 93f9adafefb3 -r 5aaa90258733 src/ChangeLog --- a/src/ChangeLog Sun Mar 10 13:09:43 2019 +0000 +++ b/src/ChangeLog Sun Mar 10 14:06:13 2019 +0000 ＠＠ -1,3 +1,30 ＠＠ +2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> + + * buffer.c (complex_vars_of_buffer): + Document the revised format of the undo list, where the saved + modification time is now whatever was supplied by make_time(). + * buffer.h (struct buffer): + Make modtime and auto_save_failure_time into time_t, not int. + * editfns.c (lisp_to_time): + Give this a docstring, and declare it as returning a Boolint, for + more clarity about what's going on with its return value. + * fileio.c: + * fileio.c (Fset_visited_file_modtime): + Update the time of buf->modtime in this function. + * lisp.h: + Make lisp_to_time() generally available. + * select-gtk.c (symbol_to_gtk_atom): + No need to declare lisp_to_time() here, nor the long-obsolete + time_to_lisp(). + * select-x.c: + No need to declare lisp_to_time() here, and we are using + lisp_to_uint32_t() anyway, as appropriate for X11. + * undo.c (undo_prelude): + Just call make_time() here when saving the modification time, + don't implement it ourselves. + * undo.c (Fprimitive_undo): + Use lisp_to_time() here, rather than implementing it ourselves. + 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> Move the buffer last_window_start to being a zero-length extent, diff -r 93f9adafefb3 -r 5aaa90258733 src/buffer.c --- a/src/buffer.c Sun Mar 10 13:09:43 2019 +0000 +++ b/src/buffer.c Sun Mar 10 14:06:13 2019 +0000 ＠＠ -2816,9 +2816,9 ＠＠ from (abs POSITION). If POSITION is positive, point was at the front of the text being deleted; if negative, point was at the end. -An entry (t HIGH . LOW) indicates that the buffer previously had -"unmodified" status. HIGH and LOW are the high and low 16-bit portions -of the visited file's modification time, as of that time. If the +An entry (t CONS) indicates that the buffer previously had "unmodified" +status. CONS is a Lisp representation of the visited file's modification time +at that point. See the SPECIFIED-TIME argument to `decode-time'. If the modification time of the most recent save is different, this entry is obsolete. diff -r 93f9adafefb3 -r 5aaa90258733 src/buffer.h --- a/src/buffer.h Sun Mar 10 13:09:43 2019 +0000 +++ b/src/buffer.h Sun Mar 10 14:06:13 2019 +0000 ＠＠ -245,14 +245,14 ＠＠ -1 means visited file was nonexistent. 0 means visited file modtime unknown; in no case complain about any mismatch on next save attempt. */ - int modtime; + time_t modtime; /* the value of text->modiff at the last auto-save. */ long auto_save_modified; /* The time at which we detected a failure to auto-save, Or -1 if we didn't have a failure. */ - int auto_save_failure_time; + time_t auto_save_failure_time; /* Everything from here down must be a Lisp_Object */ diff -r 93f9adafefb3 -r 5aaa90258733 src/editfns.c --- a/src/editfns.c Sun Mar 10 13:09:43 2019 +0000 +++ b/src/editfns.c Sun Mar 10 14:06:13 2019 +0000 ＠＠ -958,8 +958,12 ＠＠ } -int lisp_to_time (Lisp_Object specified_time, time_t *result); -int +/* Decode SPECIFIED_TIME, a Lisp_Object in the format documented in the + docstring to `decode-time', storing the result at the address specified by + RESULT. + Return non-zero if this decoding was successful. + Error if the format of SPECIFIED_TIME does not match what we expect. */ +Boolint lisp_to_time (Lisp_Object specified_time, time_t *result) { Lisp_Object high, low; diff -r 93f9adafefb3 -r 5aaa90258733 src/fileio.c --- a/src/fileio.c Sun Mar 10 13:09:43 2019 +0000 +++ b/src/fileio.c Sun Mar 10 14:06:13 2019 +0000 ＠＠ -63,8 +63,6 ＠＠ #define DRIVE_LETTER(x) tolower (x) #endif /* WIN32_NATIVE || CYGWIN */ -int lisp_to_time (Lisp_Object, time_t *); - /* Nonzero during writing of auto-save files */ static int auto_saving; ＠＠ -3286,7 +3284,7 ＠＠ filename))); /* If visiting nonexistent file, return nil. */ - if (buf->modtime == -1) + if (buf->modtime == (time_t)(-1)) report_file_error ("Opening input file", filename); } ＠＠ -3982,7 +3980,7 ＠＠ { time_t the_time; lisp_to_time (time_list, &the_time); - current_buffer->modtime = (int) the_time; + current_buffer->modtime = the_time; } else { diff -r 93f9adafefb3 -r 5aaa90258733 src/lisp.h --- a/src/lisp.h Sun Mar 10 13:09:43 2019 +0000 +++ b/src/lisp.h Sun Mar 10 14:06:13 2019 +0000 ＠＠ -4830,6 +4830,7 ＠＠ Lisp_Object make_string_from_buffer (struct buffer *, Charbpos, Charcount); Lisp_Object make_string_from_buffer_no_extents (struct buffer *, Charbpos, Charcount); Lisp_Object make_time (time_t); +Boolint lisp_to_time (Lisp_Object, time_t *); Lisp_Object save_excursion_save (void); Lisp_Object save_restriction_save (struct buffer *buf); Lisp_Object save_excursion_restore (Lisp_Object); diff -r 93f9adafefb3 -r 5aaa90258733 src/select-gtk.c --- a/src/select-gtk.c Sun Mar 10 13:09:43 2019 +0000 +++ b/src/select-gtk.c Sun Mar 10 14:06:13 2019 +0000 ＠＠ -45,9 +45,6 ＠＠ Lisp_Object Qgtk_sent_selection_hooks; -extern int lisp_to_time (Lisp_Object, time_t *); -extern Lisp_Object time_to_lisp (time_t); - static GdkAtom symbol_to_gtk_atom (struct device *UNUSED (d), Lisp_Object sym, int only_if_exists) diff -r 93f9adafefb3 -r 5aaa90258733 src/select-x.c --- a/src/select-x.c Sun Mar 10 13:09:43 2019 +0000 +++ b/src/select-x.c Sun Mar 10 14:06:13 2019 +0000 ＠＠ -35,8 +35,6 ＠＠ #include "systime.h" -int lisp_to_time (Lisp_Object, time_t *); - #ifdef LWLIB_USES_MOTIF # define MOTIF_CLIPBOARDS #endif diff -r 93f9adafefb3 -r 5aaa90258733 src/undo.c --- a/src/undo.c Sun Mar 10 13:09:43 2019 +0000 +++ b/src/undo.c Sun Mar 10 14:06:13 2019 +0000 ＠＠ -92,10 +92,7 ＠＠ entry we can tell whether it is obsolete because the file was saved again. */ b->undo_list - = Fcons (Fcons (Qt, - Fcons (make_fixnum ((b->modtime >> 16) & 0xffff), - make_fixnum (b->modtime & 0xffff))), - b->undo_list); + = Fcons (Fcons (Qt, make_time (b->modtime)), b->undo_list); } return 1; } ＠＠ -406,13 +403,10 ＠＠ if (EQ (car, Qt)) { /* Element (t high . low) records previous modtime. */ - Lisp_Object high, low; - int mod_time; - if (!CONSP (cdr)) goto rotten; - high = XCAR (cdr); - low = XCDR (cdr); - if (!FIXNUMP (high) || !FIXNUMP (low)) goto rotten; - mod_time = (XFIXNUM (high) << 16) + XFIXNUM (low); + time_t mod_time; + + if (!lisp_to_time (cdr, &mod_time)) goto rotten; + /* If this records an obsolete save (not matching the actual disk file) then don't mark unmodified. */ -- ‘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 last_window_start a zero-length extent; ditto saved window points. 5 years, 9 months

Aidan Kehoe

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net> # Date 1552223383 0 # Sun Mar 10 13:09:43 2019 +0000 # Node ID 93f9adafefb31b803e6ed8d5062aa3ce70b46ff4 # Parent cc27eb6f808b9fe3055bd866e521f2646b2556b2 Make last_window_start a zero-length extent; ditto saved window points. src/ChangeLog addition: 2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> Move the buffer last_window_start to being a zero-length extent, not an int. Move the window saved point to being a zero-length extent also, to give better behaviour with editing and deleting as we saw previously with http://mid.xemacs.org/539b.674c.c8912.0ca7＠parhasard.net . * buffer.c (finish_init_buffer): * buffer.c (Ferase_buffer): Initialise last_window_start as Qnil in both these functions, meaning use the beginning of the visible region within redisplay. * buffer.h (struct buffer): Remove last_window_start from the non-Lisp_Object part of the buffer slots. * bufslots.h: Save it here instead, mark it as a Lisp_Object as appropriate. * window.c (unshow_buffer): Save the last point for this window and the window start as zero-length extents rather than markers. * window.c (Fset_window_buffer): Use the zero-length extents rather than markers or ints. * window.c (delete_saved_window_start): New. Delete a saved window start zero-length extent, unless it is the last_window_start for the associated buffer. * window.c (Fdelete_window): Use this when cleaning up the saved_last_window_start_cache. * winslots.h: Update the documentation for saved_point_cache, saved_last_window_start_cache. diff -r cc27eb6f808b -r 93f9adafefb3 src/ChangeLog --- a/src/ChangeLog Mon Feb 18 14:53:34 2019 +0000 +++ b/src/ChangeLog Sun Mar 10 13:09:43 2019 +0000 ＠＠ -1,3 +1,36 ＠＠ +2019-03-10 Aidan Kehoe <kehoea(a)parhasard.net> + + Move the buffer last_window_start to being a zero-length extent, + not an int. + + Move the window saved point to being a zero-length extent also, to + give better behaviour with editing and deleting as we saw + previously with + http://mid.xemacs.org/539b.674c.c8912.0ca7＠parhasard.net . + + * buffer.c (finish_init_buffer): + * buffer.c (Ferase_buffer): + Initialise last_window_start as Qnil in both these functions, + meaning use the beginning of the visible region within redisplay. + + * buffer.h (struct buffer): Remove last_window_start from the + non-Lisp_Object part of the buffer slots. + * bufslots.h: + Save it here instead, mark it as a Lisp_Object as appropriate. + * window.c (unshow_buffer): + Save the last point for this window and the window start as + zero-length extents rather than markers. + * window.c (Fset_window_buffer): + Use the zero-length extents rather than markers or ints. + * window.c (delete_saved_window_start): New. + Delete a saved window start zero-length extent, unless it is the + last_window_start for the associated buffer. + * window.c (Fdelete_window): + Use this when cleaning up the saved_last_window_start_cache. + * winslots.h: + Update the documentation for saved_point_cache, + saved_last_window_start_cache. + 2019-02-18 Aidan Kehoe <kehoea(a)parhasard.net> Prefer byte_beginning_of_line_p() throughout the C code. diff -r cc27eb6f808b -r 93f9adafefb3 src/buffer.c --- a/src/buffer.c Mon Feb 18 14:53:34 2019 +0000 +++ b/src/buffer.c Sun Mar 10 13:09:43 2019 +0000 ＠＠ -621,7 +621,7 ＠＠ reset_buffer_local_variables (b, 1); b->directory = current_buffer ? current_buffer->directory : Qnil; - b->last_window_start = 1; + b->last_window_start = Qnil; b->name = name; if (string_byte (name, 0) != ' ') ＠＠ -1762,7 +1762,7 ＠＠ widen_buffer (b, no_clip); buffer_delete_range (b, BUF_BEG (b), BUF_Z (b), 0); - b->last_window_start = 1; + b->last_window_start = Qnil; /* Prevent warnings, or suspension of auto saving, that would happen if future size is less than past size. Use of erase-buffer diff -r cc27eb6f808b -r 93f9adafefb3 src/buffer.h --- a/src/buffer.h Mon Feb 18 14:53:34 2019 +0000 +++ b/src/buffer.h Sun Mar 10 13:09:43 2019 +0000 ＠＠ -254,10 +254,6 ＠＠ Or -1 if we didn't have a failure. */ int auto_save_failure_time; - /* Position in buffer at which display started - the last time this buffer was displayed. */ - int last_window_start; - /* Everything from here down must be a Lisp_Object */ #define MARKED_SLOT(x) Lisp_Object x; diff -r cc27eb6f808b -r 93f9adafefb3 src/bufslots.h --- a/src/bufslots.h Mon Feb 18 14:53:34 2019 +0000 +++ b/src/bufslots.h Sun Mar 10 13:09:43 2019 +0000 ＠＠ -233,6 +233,12 ＠＠ /* Last time this buffer was displayed using set-window-buffer. */ MARKED_SLOT (display_time) + /* Position in buffer at which display started the last time this buffer + was displayed, as a zero-length extent or Qnil, if this buffer was + never displayed. It is rare that this is not also reachable through + some window saved_last_window_start_cache hash table. */ + MARKED_SLOT (last_window_start) + /* A hash table that maps from a "generic extent" (an extent in `modeline-format') into a buffer-specific extent. */ MARKED_SLOT (modeline_extent_table) diff -r cc27eb6f808b -r 93f9adafefb3 src/window.c --- a/src/window.c Mon Feb 18 14:53:34 2019 +0000 +++ b/src/window.c Sun Mar 10 13:09:43 2019 +0000 ＠＠ -2047,72 +2047,81 ＠＠ unshow_buffer (struct window *w) { Lisp_Object buf = w->buffer; + Lisp_Object saved_point = Fgethash (buf, w->saved_point_cache, Qnil); + Lisp_Object saved_window_start + = Fgethash (buf, w->saved_last_window_start_cache, Qnil); + Boolint selected = EQ (wrap_window (w), Fselected_window (Qnil)); struct buffer *b = XBUFFER (buf); assert (b == XMARKER (w->pointm[CURRENT_DISP])->buffer); - /* FSF disables this check, so I'll do it too. I hope it won't - break things. --ben */ -#if 0 - if (w == XWINDOW (Fselected_window (Qnil)) - || ! EQ (buf, XWINDOW (Fselected_window (Qnil))->buffer)) - /* Do this except when the selected window's buffer - is being removed from some other window. */ -#endif - /* last_window_start records the start position that this buffer - had in the last window to be disconnected from it. - Now that this statement is unconditional, - it is possible for the buffer to be displayed in the - selected window, while last_window_start reflects another - window which was recently showing the same buffer. - Some people might say that might be a good thing. Let's see. */ - XBUFFER (buf)->last_window_start = - marker_position (w->start[CURRENT_DISP]); - /* Point in the selected window's buffer is actually stored in that buffer, and the window's pointm isn't used. So don't clobber point in that buffer. */ - if (! EQ (buf, XWINDOW (Fselected_window (Qnil))->buffer)) - BUF_SET_PT (b, - charbpos_clip_to_bounds - (BUF_BEGV (b), - marker_position (w->pointm[CURRENT_DISP]), - BUF_ZV (b))); - - { - Lisp_Object marker; - Lisp_Object saved_point = Fgethash (buf, w->saved_point_cache, Qnil); - int selected = EQ (wrap_window (w), Fselected_window (Qnil)); - - if (NILP (saved_point)) - { - saved_point = Fmake_extent (Qnil, Qnil, buf); - Fset_extent_property (saved_point, Qstart_open, Qt); - Fputhash (buf, saved_point, w->saved_point_cache); - } - - if (selected) - { - set_extent_endpoints (XEXTENT (saved_point), - BYTE_BUF_PT (b), BYTE_BUF_PT (b), buf); - } - else - { - set_extent_endpoints (XEXTENT (saved_point), - byte_marker_position (w->pointm[CURRENT_DISP]), - byte_marker_position (w->pointm[CURRENT_DISP]), - buf); - } - - marker = Fgethash (buf, w->saved_last_window_start_cache, Qnil); - - if (NILP (marker)) - { - marker = Fmake_marker (); - Fputhash (buf, marker, w->saved_last_window_start_cache); - } - Fset_marker (marker, w->start[CURRENT_DISP], buf); - } + if (!EQ (buf, XWINDOW (Fselected_window (Qnil))->buffer)) + { + set_marker_restricted (b->point_marker, w->pointm[CURRENT_DISP], buf); + } + + if (NILP (saved_point)) + { + /* This is a start-open extent rather than a marker because of the + behaviour of markers on deletion of text. See + http://mid.xemacs.org/539b.674c.c8912.0ca7＠parhasard.net and the + associated thread. */ + saved_point = Fmake_extent (Qnil, Qnil, buf); + Fset_extent_property (saved_point, Qstart_open, Qt); + Fputhash (buf, saved_point, w->saved_point_cache); + } + + if (selected) + { + set_extent_endpoints (XEXTENT (saved_point), + BYTE_BUF_PT (b), BYTE_BUF_PT (b), buf); + } + else + { + set_extent_endpoints (XEXTENT (saved_point), + byte_marker_position (w->pointm[CURRENT_DISP]), + byte_marker_position (w->pointm[CURRENT_DISP]), + buf); + } + + if (NILP (saved_window_start)) + { + /* This is a start-open extent rather than a marker because of the + behaviour of markers on deletion of text. See + http://mid.xemacs.org/539b.674c.c8912.0ca7＠parhasard.net and the + associated thread. */ + saved_window_start = Fmake_extent (Qnil, Qnil, buf); + Fset_extent_property (saved_window_start, Qstart_open, Qt); + Fputhash (buf, saved_window_start, w->saved_last_window_start_cache); + } + + set_extent_endpoints (XEXTENT (saved_window_start), + byte_marker_position (w->start[CURRENT_DISP]), + byte_marker_position (w->start[CURRENT_DISP]), + buf); + + /* last_window_start records the start position that this buffer + had in the last window to be disconnected from it. + Now that this statement is unconditional, + it is possible for the buffer to be displayed in the + selected window, while last_window_start reflects another + window which was recently showing the same buffer. + Some people might say that might be a good thing. Let's see. + + The above is from Stallman in 1994, and it seems to work well. A more + recent XEmacs change is that last_window_start is now either a + zero-length extent, or Qnil, something which may or may not work + well. (It previously was just an int (not even a Charbpos) reflecting + the marker position of w->start[CURRENT_DISP] when this function was + called.) This costs approximately nothing in terms of memory and + buffer-editing speed, since we re-use the extent that's already in + the window cache. + + Aidan Kehoe, So 10 Mär 2019 12:32:29 GMT */ + XBUFFER (buf)->last_window_start = saved_window_start; } /* Put REPLACEMENT into the window structure in place of OLD. */ ＠＠ -2246,6 +2255,26 ＠＠ return 0; } +static int +delete_saved_window_start (Lisp_Object UNUSED (buffer), + Lisp_Object saved_window_start, + void *UNUSED (closure)) +{ + Lisp_Object obj = Fextent_object (saved_window_start); + + if (BUFFERP (obj) + && EQ (saved_window_start, XBUFFER (obj)->last_window_start)) + { + /* Keep this extent around, it may be helpful the next time the buffer + is shown. */; + } + else + { + Fdelete_extent (saved_window_start); + } + return 0; +} + DEFUN ("delete-window", Fdelete_window, 0, 2, "", /* Remove WINDOW from the display. Default is selected window. If window is the only one on its frame, the frame is deleted as well. ＠＠ -2364,6 +2393,10 ＠＠ is. */ elisp_maphash_unsafe (delete_saved_point, w->saved_point_cache, NULL); + /* Ditto the saved window starts. */ + elisp_maphash_unsafe (delete_saved_window_start, + w->saved_last_window_start_cache, NULL); + /* close up the hole in the sibling list */ if (!NILP (w->next)) XWINDOW (w->next)->prev = w->prev; ＠＠ -3731,9 +3764,10 ＠＠ */ (window, buffer, norecord)) { - Lisp_Object tem; struct window *w = decode_window (window); + Lisp_Object tem, saved_point, saved_window_start; int old_buffer_local_face_property = 0; + Bytebpos bpoint, bstart; buffer = Fget_buffer (buffer); CHECK_BUFFER (buffer); ＠＠ -3761,45 +3795,61 ＠＠ w->window_end_pos[CURRENT_DISP] = 0; w->hscroll = 0; w->modeline_hscroll = 0; -#if 0 /* pre point caches */ - Fset_marker (w->pointm[CURRENT_DISP], - make_fixnum (BUF_PT (XBUFFER (buffer))), - buffer); - set_marker_restricted (w->start[CURRENT_DISP], - make_fixnum (XBUFFER (buffer)->last_window_start), - buffer); -#else - { - Lisp_Object saved_point = Fgethash (buffer, w->saved_point_cache, Qnil); - Lisp_Object newpoint = - (EXTENTP (saved_point) && NILP (Fextent_detached_p (saved_point))) - ? Fextent_start_position (saved_point) - : make_fixnum (BUF_PT (XBUFFER (buffer))); - Lisp_Object marker; - /* Previously, we had in here set-window-point, which did one of the - following two, but not both. However, that could result in pointm - being in a different buffer from the window's buffer! Probably - not a travesty since it always occurred when the window was - selected, meaning its value of point was ignored in favor of the - buffer's; but it tripped an assert() in unshow_buffer(). */ - set_marker_restricted (w->pointm[CURRENT_DISP], newpoint, buffer); - if (EQ (wrap_window (w), Fselected_window (Qnil))) - Fgoto_char (newpoint, buffer); /* this will automatically clip to - accessible */ - marker = Fgethash (buffer, w->saved_last_window_start_cache, Qnil); - set_marker_restricted (w->start[CURRENT_DISP], - !NILP (marker) ? - make_fixnum (marker_position (marker)) : - make_fixnum (XBUFFER (buffer)->last_window_start), - buffer); - } -#endif - - Fset_marker (w->sb_point, w->start[CURRENT_DISP], buffer); + + saved_point = Fgethash (buffer, w->saved_point_cache, Qnil); + bpoint = (EXTENTP (saved_point) && NILP (Fextent_detached_p (saved_point))) + ? extent_endpoint_byte (XEXTENT (saved_point), 0) + : BYTE_BUF_PT (XBUFFER (buffer)); + + /* Adjust this so we don't have to call set_marker_restricted(). */ + bpoint = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (XBUFFER (buffer)), + bpoint, + BYTE_BUF_ZV (XBUFFER (buffer))); + + structure_checking_assert (!EXTENTP (saved_point) + || EQ (Fextent_object (saved_point), buffer)); + + /* Previously, we had in here set-window-point, which did one of the + following two, but not both. However, that could result in pointm being + in a different buffer from the window's buffer! Probably not a travesty + since it always occurred when the window was selected, meaning its value + of point was ignored in favor of the buffer's; but it tripped an assert() + in unshow_buffer(). */ + set_byte_marker_position (w->pointm[CURRENT_DISP], bpoint, buffer); + if (EQ (wrap_window (w), Fselected_window (Qnil))) + { + BYTE_BUF_SET_PT (XBUFFER (buffer), bpoint); + } + + saved_window_start + = Fgethash (buffer, w->saved_last_window_start_cache, Qnil); + if (!EXTENTP (saved_window_start)) + { + saved_window_start = XBUFFER (buffer)->last_window_start; + } + + structure_checking_assert (!EXTENTP (saved_window_start) + || EQ (Fextent_object (saved_window_start), + buffer)); + + if (EXTENTP (saved_window_start) + && NILP (Fextent_detached_p (saved_window_start))) + { + bstart = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (XBUFFER (buffer)), + extent_endpoint_byte + (XEXTENT (saved_window_start), 0), + BYTE_BUF_ZV (XBUFFER (buffer))); + } + else + { + bstart = BYTE_BUF_BEGV (XBUFFER (buffer)); + } + + set_byte_marker_position (w->start[CURRENT_DISP], bstart, buffer); + set_byte_marker_position (w->sb_point, bstart, buffer); + /* set start_at_line_beg correctly. GE */ - w->start_at_line_beg = - byte_beginning_of_line_p (XBUFFER (buffer), - byte_marker_position (w->start[CURRENT_DISP])); + w->start_at_line_beg = byte_beginning_of_line_p (XBUFFER (buffer), bstart); w->force_start = 0; /* XEmacs fix */ SET_LAST_MODIFIED (w, 1); SET_LAST_FACECHANGE (w); diff -r cc27eb6f808b -r 93f9adafefb3 src/winslots.h --- a/src/winslots.h Mon Feb 18 14:53:34 2019 +0000 +++ b/src/winslots.h Sun Mar 10 13:09:43 2019 +0000 ＠＠ -125,18 +125,18 ＠＠ /* A marker pointing to where in the text the scrollbar is pointing; #### moved to scrollbar.c? */ WINDOW_SLOT (sb_point) - /* A table that remembers (in marker form) the value of point in buffers - previously displayed in this window. Switching back to those buffers - causes the remembered point value to become current, rather than the - buffer's point. This is so that you get sensible behavior if you have - a buffer displayed in multiple windows and temporarily switch away and - then back in one window. We don't save or restore this table in a - window configuration, since that would be counterproductive -- we - always want to remember the most recent value of point in buffers we - switched away from. */ + /* A table that remembers (in zero-length-extent form) the value of point in + buffers previously displayed in this window. Switching back to those + buffers causes the remembered point value to become current, rather than + the buffer's point. This is so that you get sensible behavior if you + have a buffer displayed in multiple windows and temporarily switch away + and then back in one window. We don't save or restore this table in a + window configuration, since that would be counterproductive -- we always + want to remember the most recent value of point in buffers we switched + away from. */ WINDOW_SLOT (saved_point_cache) - /* A table that remembers (in marker form) the value of window start in - buffers previously displayed in this window. Save reason as for + /* A table that remembers (in zero-length extent form) the value of window + start in buffers previously displayed in this window. Same reason as for the previous table. */ WINDOW_SLOT (saved_last_window_start_cache) -- ‘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 March 2019