Mercurial > hg > xemacs-beta
changeset 844:047d37eb70d7
[xemacs-hg @ 2002-05-16 13:30:23 by ben]
ui fixes for things that were bothering me
bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers
(integers representing the amount of text on either side of the
region). That way, all inserts are handled correctly, not just
those inside old restriction.
Add buffer argument to save_restriction_save().
process.c: Clean up very dirty and kludgy code that outputs into a buffer --
use proper unwind protects, etc.
font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect
results will ensue when a buffer has been narrowed before a call to
e.g. `buffer-syntactic-context' -- something that happens quite often.
fileio.c: Look for a handler for make-temp-name.
window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the
buffer, in different places; in one, temporarily switch away to
another buffer and then back -- and you've lost your position;
it's reset to the other one in the other frame. My current
solution involves window-level caches of buffers and points (also
a cache for window-start); when set-window-buffer is called, it
looks to see if the buffer was previously visited in the window,
and if so, uses the most recent point at that time. (It's a
marker, so it handles changes.)
#### Note: It could be argued that doing it on the frame level
would be better -- e.g. if you visit a buffer temporarily through
a grep, and then go back to that buffer, you presumably want the
grep's position rather than some previous position provided
everything was in the same frame, even though the grep was in
another window in the frame. However, doing it on the frame level
fails when you have two windows on the same frame. Perhaps we
keep both a window and a frame cache, and use the frame cache if
there are no other windows on the frame showing the buffer, else
the window's cache? This is probably something to be configurable
using a specifier. Suggestions please please please?
window.c: Clean up a bit code that deals with the annoyance of window-point
vs. point.
dialog.el: Function to ask a
multiple-choice question, automatically choosing a dialog box or
minibuffer representation as necessary. Generalized version of
yes-or-no-p, y-or-n-p.
files.el: Use get-user-response to ask "yes/no/diff" question when recovering.
"diff" means that a diff is displayed between the current file and the
autosave. (Converts/deconverts escape-quoted as necessary. No more
complaints from you, Mr. Turnbull!) One known problem: when a dialog
is used, it's modal, so you can't scroll the diff. Will fix soon.
lisp-mode.el: If we're filling a string, don't treat semicolon as a comment,
which would give very unfriendly results.
Uses `buffer-syntactic-context'.
simple.el: all changes back to the beginning. (Useful if you've saved the file
in the middle of the changes.)
simple.el: Add option kill-word-into-kill-ring, which controls whether words
deleted with kill-word, backward-kill-word, etc. are "cut" into the
kill ring, or "cleared" into nothingness. (My preference is the
latter, by far. I'd almost go so far as suggesting we make it the
default, as you can always select a word and then cut it if you want
it cut.)
menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
| author | ben |
|---|---|
| date | Thu, 16 May 2002 13:30:58 +0000 |
| parents | f46864126a0d |
| children | 77624ff6e2da |
| files | lisp/ChangeLog lisp/dialog.el lisp/files.el lisp/lisp-mode.el lisp/menubar-items.el lisp/simple.el src/ChangeLog src/bytecode.c src/editfns.c src/fileio.c src/font-lock.c src/lisp.h src/lread.c src/process.c src/window.c src/winslots.h |
| diffstat | 16 files changed, 585 insertions(+), 208 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed May 15 15:27:58 2002 +0000 +++ b/lisp/ChangeLog Thu May 16 13:30:58 2002 +0000 @@ -1,3 +1,43 @@ +2002-05-16 Ben Wing <ben@xemacs.org> + + * dialog.el: + * dialog.el (get-user-response): New. Function to ask a + multiple-choice question, automatically choosing a dialog box or + minibuffer representation as necessary. Generalized version of + yes-or-no-p, y-or-n-p. + + * files.el: + * files.el (recover-file-diff-program): New. + * files.el (recover-file-diff-arguments): New. + * files.el (recover-file): + Use get-user-response to ask "yes/no/diff" question when recovering. + "diff" means that a diff is displayed between the current file and the + autosave. (Converts/deconverts escape-quoted as necessary. No more + complaints from you, Mr. Turnbull!) One known problem: when a dialog + is used, it's modal, so you can't scroll the diff. Will fix soon. + + * lisp-mode.el (lisp-fill-paragraph): + If we're filling a string, don't treat semicolon as a comment, + which would give very unfriendly results. + Uses `buffer-syntactic-context'. + + * simple.el: + * simple.el (undo-all-changes): New. + all changes back to the beginning. (Useful if you've saved the file + in the middle of the changes.) + + * simple.el (kill-word-into-kill-ring): New. + * simple.el (backward-kill-word): + Add option kill-word-into-kill-ring, which controls whether words + deleted with kill-word, backward-kill-word, etc. are "cut" into the + kill ring, or "cleared" into nothingness. (My preference is the + latter, by far. I'd almost go so far as suggesting we make it the + default, as you can always select a word and then cut it if you want + it cut.) + + * menubar-items.el (default-menubar): + Add option corresponding to kill-word-into-kill-ring. + 2002-05-09 Stephen J. Turnbull <stephen@xemacs.org> This patch is based on Jerry James's patch and analysis.
--- a/lisp/dialog.el Wed May 15 15:27:58 2002 +0000 +++ b/lisp/dialog.el Thu May 16 13:30:58 2002 +0000 @@ -1,7 +1,7 @@ ;;; dialog.el --- Dialog-box support for XEmacs ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 2000 Ben Wing. +;; Copyright (C) 2000, 2002 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, internal, dumped @@ -25,6 +25,9 @@ ;;; Synched up with: Not in FSF. +;;; Authorship: Mostly written or rewritten by Ben Wing; some old old stuff +;;; that underlies some current code was written by JWZ. + ;;; Commentary: ;; This file is dumped with XEmacs (when dialog boxes are compiled in). @@ -89,6 +92,116 @@ `[,(car x) (dialog-box-finish ',(cdr x)) t]))) (cdr contents)))) +(defun get-user-response (position question answers) + "Ask a question and get a response from the user, in minibuffer or dialog box. +POSITION specifies which frame to use. +This is normally an event or a window or frame. +If POSITION is t or nil, it means to use the frame the mouse is on. +The dialog box appears in the middle of the specified frame. + +QUESTION is the question to ask (it should end with a question mark followed +by a space). + +ANSWERS are the possible answers. It is a list; each item looks like + + (KEY BUTTON-TEXT RESPONSE) + +where KEY is the key to be pressed in the minibuffer, BUTTON-TEXT is the +text to be displayed in a dialog box button (you should put %_ in it to +indicate the accelerator), and RESPONSE is a value (typically a symbol) +to be returned if the user selects this response. KEY should be either a +single character or a string; which one you use needs to be consistent for +all responses and determines whether the user responds by hitting a single +key or typing in a string and hitting ENTER. + +An item may also be just a string--that makes a nonselectable item in the +dialog box and is ignored in the minibuffer. + +An item may also be nil -- that means to put all preceding items +on the left of the dialog box and all following items on the right; ignored +in the minibuffer." + (if (should-use-dialog-box-p) + (get-dialog-box-response + position + (cons question + (mapcar #'(lambda (x) + (cond + ((null x) nil) + ((stringp x) x) + (t (cons (second x) (third x))))) + answers))) + (save-excursion + (let* ((answers (remove-if-not #'consp answers)) + (possible + (gettext + (flet ((car-to-string-if (x) + (setq x (car x)) + (if (stringp x) x (char-to-string x)))) + (concat (mapconcat #'car-to-string-if + (butlast answers) ", ") " or " + (car-to-string-if (car (last answers))))))) + (question (gettext question)) + (p (format "%s(%s) " question possible))) + (block nil + (if (stringp (caar answers)) + ;; based on yes-or-no-p. + (while t + (let* ((ans (downcase (read-string p nil t))) ;no history + (res (member* ans answers :test #'equal :key #'car))) + (if res (return (third (car res))) + (ding nil 'yes-or-no-p) + (discard-input) + (message "Please answer %s." possible) + (sleep-for 2)))) + ;; based on y-or-n-p. + (save-excursion + (let* ((pre "") event) + (while t + (if (let ((cursor-in-echo-area t) + (inhibit-quit t)) + (message "%s%s(%s) " pre question possible) + (setq event (next-command-event event)) + (condition-case nil + (prog1 + (or quit-flag (eq 'keyboard-quit + (key-binding event))) + (setq quit-flag nil)) + (wrong-type-argument t))) + (progn + (message "%s%s(%s) %s" pre question possible + (single-key-description event)) + (setq quit-flag nil) + (signal 'quit '()))) + (let* ((keys (events-to-keys (vector event))) + (def (lookup-key query-replace-map keys))) + (cond +; ((eq def 'skip) +; (message "%s%sNo" question possible) +; (return nil)) +; ((eq def 'act) +; (message "%s%sYes" question possible) +; (return t)) + ((eq def 'recenter) + (recenter)) + ((or (eq def 'quit) (eq def 'exit-prefix)) + (signal 'quit '())) + ((button-release-event-p event) ; ignore them + nil) + (t + (let ((res (member* (event-to-character event) answers + :key #'car))) + (if res (return (third (car res))) + (message "%s%s(%s) %s" pre question possible + (single-key-description event)) + (ding nil 'y-or-n-p) + (discard-input) + (if (= (length pre) 0) + (setq pre (format "Please answer %s. " + ;; 17 parens! a record in + ;; our lisp code. + possible))))))))))))))))) + + (defun message-box (fmt &rest args) "Display a message, in a dialog box if possible. If the selected device has no dialog-box support, use the echo area.
--- a/lisp/files.el Wed May 15 15:27:58 2002 +0000 +++ b/lisp/files.el Thu May 16 13:30:58 2002 +0000 @@ -2995,6 +2995,11 @@ newbuf nil))) +(defvar recover-file-diff-program "diff" + "Absolute or relative name of the `diff' program used by `recover-file'.") +(defvar recover-file-diff-arguments '("-c") + "List of arguments (switches) to pass to `diff' by `recover-file'.") + (defun recover-file (file) "Visit file FILE, but get contents from its last auto-save file." ;; Actually putting the file name in the minibuffer should be used @@ -3017,9 +3022,10 @@ (not (file-newer-than-file-p file-name file)) (not (file-exists-p file-name))) (error "Auto-save file %s not current" file-name)) - ((save-window-excursion + (t + (save-window-excursion ;; XEmacs change: use insert-directory instead of - ;; calling ls directly. + ;; calling ls directly. Add option for diff. (with-output-to-temp-buffer "*Directory*" (buffer-disable-undo standard-output) (save-excursion @@ -3029,14 +3035,85 @@ (if (file-symlink-p file) "-lL" "-l")) (setq default-directory (file-name-directory file-name)) (insert-directory file-name "-l"))) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) - (switch-to-buffer (find-file-noselect file t)) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((coding-system-for-read 'escape-quoted)) - (insert-file-contents file-name nil))) - (after-find-file nil nil t)) - (t (error "Recover-file cancelled."))))))) + (block nil + (while t + (case (get-user-response + nil + ;; Formerly included file name. Useless now that + ;; we display an ls of the files, and potentially + ;; fills up the minibuffer, esp. with autosaves + ;; all in one directory. + "Recover auto save file? " + '(("yes" "%_Yes" yes) + ("no" "%_No" no) + ("diff" "%_Diff" diff))) + (no (error "Recover-file cancelled.")) + (yes + (switch-to-buffer (find-file-noselect file t)) + (let ((buffer-read-only nil)) + (erase-buffer) + (let ((coding-system-for-read 'escape-quoted)) + (insert-file-contents file-name nil))) + (after-find-file nil nil t) + (return nil)) + (diff + ;; rather than just diff the two files (which would + ;; be easy), we have to deal with the fact that + ;; they may be in different formats, since + ;; auto-saves are always in escape-quoted. so, we + ;; read the file into a buffer (#### should we look + ;; at or use a file if it's already in a buffer? + ;; maybe we would find hints as to the encoding of + ;; the file?), then we save the resulting buffer in + ;; escape-quoted, do the diff (between two files + ;; both in escape-quoted) and read in the results + ;; using coding system escape-quoted. That way, we + ;; should get what's correct most of the time. + (let ((buffer (generate-new-buffer "*recover*")) + (temp + (make-temp-name + (concat (file-name-as-directory + (temp-directory)) + (file-name-nondirectory file) "-")))) + (unwind-protect + (progn + (save-current-buffer + (set-buffer buffer) + (insert-file-contents file) + (let ((coding-system-for-write + 'escape-quoted)) + (write-region (point-min) (point-max) + temp nil 'silent))) + (with-output-to-temp-buffer "*Autosave Diff*" + (buffer-disable-undo standard-output) + (let ((coding-system-for-read + 'escape-quoted)) + (condition-case ferr + (apply #'call-process + recover-file-diff-program + nil standard-output nil + (append + recover-file-diff-arguments + (list temp file-name))) + (io-error + (save-excursion + (set-buffer standard-output) + (setq default-directory + (file-name-directory file)) + (insert-directory + file + (if (file-symlink-p file) "-lL" + "-l")) + (setq default-directory + (file-name-directory file-name)) + (insert-directory file-name "-l") + (terpri) + (princ "Error during diff: ") + (display-error ferr + standard-output))))))) + (ignore-errors (kill-buffer buffer)) + (ignore-file-errors + (delete-file temp))))))))))))))) (defun recover-session () "Recover auto save files from a previous Emacs session.
--- a/lisp/lisp-mode.el Wed May 15 15:27:58 2002 +0000 +++ b/lisp/lisp-mode.el Thu May 16 13:30:58 2002 +0000 @@ -983,7 +983,10 @@ (cond ((eq (char-after (point)) ?\\) (forward-char 2)) ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1)))) - (looking-at ";+[\t ]*")) + ;; don't do comment filling in a string, or we will mess up + ;; doc strings and other places where semicolons are used. + (and (not (eq 'string (buffer-syntactic-context))) + (looking-at ";+[\t ]*"))) (error nil)) (setq has-comment t has-code-and-comment t) (setq comment-fill-prefix
--- a/lisp/menubar-items.el Wed May 15 15:27:58 2002 +0000 +++ b/lisp/menubar-items.el Thu May 16 13:30:58 2002 +0000 @@ -890,7 +890,12 @@ :style toggle :selected (and (boundp 'pending-delete-mode) pending-delete-mode) :active (boundp 'pending-delete-mode)] - ["`%_kill-line' Kills Whole Line at %_Beg" + ["`kill-%_word' Stores in Clipboard" + (customize-set-variable 'kill-word-into-kill-ring + (not kill-word-into-kill-ring)) + :style toggle + :selected kill-word-into-kill-ring] + ["`kill-%_line' Kills Whole Line at Beg" (customize-set-variable 'kill-whole-line (not kill-whole-line)) :style toggle :selected kill-whole-line]
--- a/lisp/simple.el Wed May 15 15:27:58 2002 +0000 +++ b/lisp/simple.el Thu May 16 13:30:58 2002 +0000 @@ -959,6 +959,14 @@ (setq pending-undo-list (primitive-undo count pending-undo-list) last-undo-buffer (current-buffer))) ; XEmacs +(defun undo-all-changes () + "Keep undoing till the start of the undo list is reached. +Undoes all changes, even past a file save. Especially useful when you've +saved the file at some point." + (interactive) + (undo-start) + (while pending-undo-list (undo-more 1))) + ;; XEmacs (defun call-with-transparent-undo (fn &rest args) "Apply FN to ARGS, and then undo all changes made by FN to the current @@ -2982,11 +2990,21 @@ (interactive "p") (mark-something 'mark-word 'forward-word count)) +(defcustom kill-word-into-kill-ring t + "*Non-nil means `kill-word' saves word killed into kill ring. +\(Normally, this also affects the clipboard.) +Nil means word is just deleted, without being remembered. +This also applies to `backward-kill-word' and `backward-or-forward-kill-word'." + :type 'boolean + :group 'editing-basics) + (defun kill-word (&optional count) "Kill characters forward until encountering the end of a word. With optional argument COUNT, do this that many times." (interactive "*p") - (kill-region (point) (save-excursion (forward-word count) (point)))) + (if kill-word-into-kill-ring + (kill-region (point) (save-excursion (forward-word count) (point))) + (delete-region (point) (save-excursion (forward-word count) (point))))) (defun backward-kill-word (&optional count) "Kill characters backward until encountering the end of a word.
--- a/src/ChangeLog Wed May 15 15:27:58 2002 +0000 +++ b/src/ChangeLog Thu May 16 13:30:58 2002 +0000 @@ -1,3 +1,70 @@ +2002-05-16 Ben Wing <ben@xemacs.org> + + * bytecode.c (execute_rare_opcode): + * editfns.c: + * editfns.c (save_restriction_save): + * editfns.c (save_restriction_restore): + * editfns.c (Fsave_restriction): + * lisp.h: + * lread.c (Feval_region): + Fix save-restriction to use markers rather than pseudo-markers + (integers representing the amount of text on either side of the + region). That way, all inserts are handled correctly, not just + those inside old restriction. + + Add buffer argument to save_restriction_save(). + + * process.c: + * process.c (process_setup_for_insertion): + * process.c (read_process_output): + * process.c (status_notify): + Clean up very dirty and kludgy code that outputs into a buffer -- + use proper unwind protects, etc. + + * font-lock.c (find_context): + Do save-restriction/widen around the function -- otherwise, incorrect + results will ensue when a buffer has been narrowed before a call to + e.g. `buffer-syntactic-context' -- something that happens quite often. + + * fileio.c: + * fileio.c (Fmake_temp_name): + * fileio.c (syms_of_fileio): + Look for a handler for make-temp-name. + + * window.c: + * window.c (allocate_window): + * window.c (Fset_window_point): + * window.c (unshow_buffer): + * window.c (Fset_window_buffer): + * window.c (make_dummy_parent): + * winslots.h: + Try to solve this annoying problem: have two frames displaying the + buffer, in different places; in one, temporarily switch away to + another buffer and then back -- and you've lost your position; + it's reset to the other one in the other frame. My current + solution involves window-level caches of buffers and points (also + a cache for window-start); when set-window-buffer is called, it + looks to see if the buffer was previously visited in the window, + and if so, uses the most recent point at that time. (It's a + marker, so it handles changes.) + + #### Note: It could be argued that doing it on the frame level + would be better -- e.g. if you visit a buffer temporarily through + a grep, and then go back to that buffer, you presumably want the + grep's position rather than some previous position provided + everything was in the same frame, even though the grep was in + another window in the frame. However, doing it on the frame level + fails when you have two windows on the same frame. Perhaps we + keep both a window and a frame cache, and use the frame cache if + there are no other windows on the frame showing the buffer, else + the window's cache? This is probably something to be configurable + using a specifier. Suggestions please please please? + + * window.c (window_scroll): + * window.c (Fmove_to_window_line): + Clean up a bit code that deals with the annoyance of window-point + vs. point. + 2002-05-16 Stephen J. Turnbull <stephen@xemacs.org> * select.c (Fown_selection_internal):
--- a/src/bytecode.c Wed May 15 15:27:58 2002 +0000 +++ b/src/bytecode.c Thu May 16 13:30:58 2002 +0000 @@ -1167,7 +1167,7 @@ case Bsave_restriction: record_unwind_protect (save_restriction_restore, - save_restriction_save ()); + save_restriction_save (current_buffer)); break; case Bcatch:
--- a/src/editfns.c Wed May 15 15:27:58 2002 +0000 +++ b/src/editfns.c Thu May 16 13:30:58 2002 +0000 @@ -2042,77 +2042,71 @@ } Lisp_Object -save_restriction_save (void) +save_restriction_save (struct buffer *buf) { - Lisp_Object bottom, top; - /* Note: I tried using markers here, but it does not win + Lisp_Object bottom = noseeum_make_marker (); + Lisp_Object top = noseeum_make_marker (); + + /* Formerly, this function remembered the amount of text on either side + of the restricted area, in a halfway attempt to account for insertion -- + it handles insertion inside the old restricted area, but not outside. + The comment read: + + [[ Note: I tried using markers here, but it does not win because insertion at the end of the saved region - does not advance mh and is considered "outside" the saved region. */ - bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer)); - top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer)); + does not advance mh and is considered "outside" the saved region. ]] + + But that was clearly before the advent of marker-insertion-type. --ben */ - return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top)); + Fset_marker (bottom, make_int (BUF_BEGV (buf)), wrap_buffer (buf)); + Fset_marker (top, make_int (BUF_ZV (buf)), wrap_buffer (buf)); + Fset_marker_insertion_type (top, Qt); + + return noseeum_cons (wrap_buffer (buf), noseeum_cons (bottom, top)); } Lisp_Object save_restriction_restore (Lisp_Object data) { struct buffer *buf; - Charcount newhead, newtail; - Lisp_Object tem; + Lisp_Object markers = XCDR (data); int local_clip_changed = 0; buf = XBUFFER (XCAR (data)); - if (!BUFFER_LIVE_P (buf)) + /* someone could have killed the buffer in the meantime ... */ + if (BUFFER_LIVE_P (buf)) { - /* someone could have killed the buffer in the meantime ... */ - free_cons (XCONS (XCDR (data))); - free_cons (XCONS (data)); - return Qnil; - } - tem = XCDR (data); - newhead = XINT (XCAR (tem)); - newtail = XINT (XCDR (tem)); + Charbpos start = marker_position (XCAR (markers)); + Charbpos end = marker_position (XCDR (markers)); + Bytebpos byte_start = charbpos_to_bytebpos (buf, start); + Bytebpos byte_end = charbpos_to_bytebpos (buf, end); - free_cons (XCONS (XCDR (data))); - free_cons (XCONS (data)); + if (BUF_BEGV (buf) != start) + { + local_clip_changed = 1; + SET_BOTH_BUF_BEGV (buf, start, byte_start); + narrow_line_number_cache (buf); + } + if (BUF_ZV (buf) != end) + { + local_clip_changed = 1; + SET_BOTH_BUF_ZV (buf, end, byte_end); + } - if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf)) - { - newhead = 0; - newtail = 0; + if (local_clip_changed) + MARK_CLIP_CHANGED; + + /* If point is outside the new visible range, move it inside. */ + BUF_SET_PT (buf, charbpos_clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf), + BUF_ZV (buf))); } - { - Charbpos start, end; - Bytebpos byte_start, byte_end; - - start = BUF_BEG (buf) + newhead; - end = BUF_Z (buf) - newtail; - - byte_start = charbpos_to_bytebpos (buf, start); - byte_end = charbpos_to_bytebpos (buf, end); - - if (BUF_BEGV (buf) != start) - { - local_clip_changed = 1; - SET_BOTH_BUF_BEGV (buf, start, byte_start); - narrow_line_number_cache (buf); - } - if (BUF_ZV (buf) != end) - { - local_clip_changed = 1; - SET_BOTH_BUF_ZV (buf, end, byte_end); - } - } - if (local_clip_changed) - MARK_CLIP_CHANGED; - - /* If point is outside the new visible range, move it inside. */ - BUF_SET_PT (buf, - charbpos_clip_to_bounds (BUF_BEGV (buf), - BUF_PT (buf), - BUF_ZV (buf))); + /* Free all the junk we allocated, so that a `save-restriction' comes + for free in terms of GC junk. */ + free_marker (XMARKER (XCAR (markers))); + free_marker (XMARKER (XCDR (markers))); + free_cons (XCONS (markers)); + free_cons (XCONS (data)); return Qnil; } @@ -2129,8 +2123,9 @@ The value returned is the value of the last form in BODY. -`save-restriction' can get confused if, within the BODY, you widen -and then make changes outside the area within the saved restrictions. +As of XEmacs 22.0, `save-restriction' correctly handles all modifications +made within BODY. (Formerly, it got confused if, within the BODY, you +widened and then made changes outside the old restricted area.) Note: if you are using both `save-excursion' and `save-restriction', use `save-excursion' outermost: @@ -2139,9 +2134,9 @@ (body)) { /* This function can GC */ - int speccount = specpdl_depth (); - - record_unwind_protect (save_restriction_restore, save_restriction_save ()); + int speccount = + record_unwind_protect (save_restriction_restore, + save_restriction_save (current_buffer)); return unbind_to_1 (speccount, Fprogn (body)); }
--- a/src/fileio.c Wed May 15 15:27:58 2002 +0000 +++ b/src/fileio.c Thu May 16 13:30:58 2002 +0000 @@ -226,6 +226,7 @@ Lisp_Object Qrename_file; Lisp_Object Qadd_name_to_file; Lisp_Object Qmake_symbolic_link; +Lisp_Object Qmake_temp_name; Lisp_Object Qfile_exists_p; Lisp_Object Qfile_executable_p; Lisp_Object Qfile_readable_p; @@ -595,7 +596,11 @@ In addition, this function makes an attempt to choose a name that does not specify an existing file. To make this work, PREFIX should -be an absolute file name. +be an absolute file name. A reasonable idiom is + +\(make-temp-name (expand-file-name "myprefix" (temp-directory))) + +which puts the file in the OS-specified temporary directory. */ (prefix)) { @@ -613,8 +618,12 @@ Bytecount len; Intbyte *p, *data; + Lisp_Object handler; CHECK_STRING (prefix); + handler = Ffind_file_name_handler (prefix, Qmake_temp_name); + if (!NILP (handler)) + return call2_check_string (handler, Qmake_temp_name, prefix); /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's a bad idea because: @@ -627,8 +636,9 @@ the code that uses (make-temp-name "") instead of (make-temp-name "./"). - 3) It might yield unexpected (to stat(2)) results in the presence - of EFS and file name handlers. */ + [[ 3) It might yield unexpected (to stat(2)) results in the presence + of EFS and file name handlers.]] Now that we check for a handler, + that's less of a concern. --ben */ len = XSTRING_LENGTH (prefix); data = alloca_intbytes (len + 7); @@ -4201,6 +4211,7 @@ DEFSYMBOL (Qrename_file); DEFSYMBOL (Qadd_name_to_file); DEFSYMBOL (Qmake_symbolic_link); + DEFSYMBOL (Qmake_temp_name); DEFSYMBOL (Qfile_exists_p); DEFSYMBOL (Qfile_executable_p); DEFSYMBOL (Qfile_readable_p);
--- a/src/font-lock.c Wed May 15 15:27:58 2002 +0000 +++ b/src/font-lock.c Thu May 16 13:30:58 2002 +0000 @@ -432,6 +432,16 @@ int prev_syncode, syncode; Charbpos target = pt; struct syntax_cache *scache; + int spec = specpdl_depth (); + + /* If we are narrowed, we will get confused. In fact, we are quite often + narrowed when this function is called. */ + if (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf)) + { + record_unwind_protect (save_restriction_restore, + save_restriction_save (buf)); + Fwiden (wrap_buffer (buf)); + } setup_context_cache (buf, pt); pt = context_cache.cur_point; @@ -679,6 +689,7 @@ } context_cache.needs_its_head_reexamined = 0; + unbind_to (spec); } static Lisp_Object
--- a/src/lisp.h Wed May 15 15:27:58 2002 +0000 +++ b/src/lisp.h Thu May 16 13:30:58 2002 +0000 @@ -3358,7 +3358,7 @@ Lisp_Object make_string_from_buffer_no_extents (struct buffer *, Charbpos, Charcount); Lisp_Object make_time (time_t); Lisp_Object save_excursion_save (void); -Lisp_Object save_restriction_save (void); +Lisp_Object save_restriction_save (struct buffer *buf); Lisp_Object save_excursion_restore (Lisp_Object); Lisp_Object save_restriction_restore (Lisp_Object); void widen_buffer (struct buffer *b, int no_clip);
--- a/src/lread.c Wed May 15 15:27:58 2002 +0000 +++ b/src/lread.c Thu May 16 13:30:58 2002 +0000 @@ -1508,7 +1508,8 @@ if (NILP (stream)) record_unwind_protect (save_excursion_restore, save_excursion_save ()); - record_unwind_protect (save_restriction_restore, save_restriction_save ()); + record_unwind_protect (save_restriction_restore, + save_restriction_save (current_buffer)); /* This both uses start and checks its type. */ Fgoto_char (start, cbuf);
--- a/src/process.c Wed May 15 15:27:58 2002 +0000 +++ b/src/process.c Thu May 16 13:30:58 2002 +0000 @@ -868,6 +868,52 @@ /* Process I/O */ /************************************************************************/ +/* Set up PROCESS's buffer for insertion of process data at PROCESS's + mark. + + Sets the current buffer to PROCESS's buffer, inhibits read only, + remembers current point, sets point to PROCESS'S mark, widens if + necessary. +*/ +static int +process_setup_for_insertion (Lisp_Object process) +{ + Lisp_Process *p = XPROCESS (process); + int spec = specpdl_depth (); + struct buffer *buf = XBUFFER (p->buffer); + Charbpos output_pt; + + if (buf != current_buffer) + { + record_unwind_protect (save_current_buffer_restore, + Fcurrent_buffer ()); + set_buffer_internal (buf); + } + + record_unwind_protect (save_excursion_restore, save_excursion_save ()); + specbind (Qinhibit_read_only, Qt); + + /* Insert new output into buffer + at the current end-of-output marker, + thus preserving logical ordering of input and output. */ + if (XMARKER (p->mark)->buffer) + output_pt = marker_position (p->mark); + else + output_pt = BUF_ZV (buf); + + /* If the output marker is outside of the visible region, save + the restriction and widen. */ + if (! (BUF_BEGV (buf) <= output_pt && output_pt <= BUF_ZV (buf))) + { + record_unwind_protect (save_restriction_restore, + save_restriction_save (buf)); + Fwiden (wrap_buffer (buf)); + } + + BUF_SET_PT (buf, output_pt); + return spec; +} + /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of characters read. @@ -940,47 +986,11 @@ /* If no filter, write into buffer if it isn't dead. */ if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) { - Lisp_Object old_read_only = Qnil; - Charbpos old_point; - Charbpos old_begv; - Charbpos old_zv; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; struct buffer *buf = XBUFFER (p->buffer); - - GCPRO2 (process, old_read_only); - - old_point = BUF_PT (buf); - old_begv = BUF_BEGV (buf); - old_zv = BUF_ZV (buf); - old_read_only = buf->read_only; - buf->read_only = Qnil; + int spec = process_setup_for_insertion (process); - /* Insert new output into buffer - at the current end-of-output marker, - thus preserving logical ordering of input and output. */ - if (XMARKER (p->mark)->buffer) - BUF_SET_PT (buf, - charbpos_clip_to_bounds (old_begv, marker_position (p->mark), - old_zv)); - else - BUF_SET_PT (buf, old_zv); - - /* If the output marker is outside of the visible region, save - the restriction and widen. */ - if (! (BUF_BEGV (buf) <= BUF_PT (buf) && - BUF_PT (buf) <= BUF_ZV (buf))) - Fwiden (p->buffer); - - /* Make sure opoint floats ahead of any new text, just as point - would. */ - if (BUF_PT (buf) <= old_point) - old_point += nchars; - - /* Insert after old_begv, but before old_zv. */ - if (BUF_PT (buf) < old_begv) - old_begv += nchars; - if (BUF_PT (buf) <= old_zv) - old_zv += nchars; + GCPRO1 (process); #if 0 /* This screws up initial display of the window. jla */ @@ -994,29 +1004,8 @@ #endif Fset_marker (p->mark, make_int (BUF_PT (buf)), p->buffer); - MARK_MODELINE_CHANGED; - - /* If the restriction isn't what it should be, set it. */ - if (old_begv != BUF_BEGV (buf) || old_zv != BUF_ZV (buf)) - { - Fwiden(p->buffer); - old_begv = charbpos_clip_to_bounds (BUF_BEG (buf), - old_begv, - BUF_Z (buf)); - old_zv = charbpos_clip_to_bounds (BUF_BEG (buf), - old_zv, - BUF_Z (buf)); - Fnarrow_to_region (make_int (old_begv), make_int (old_zv), - p->buffer); - } - - buf->read_only = old_read_only; - old_point = charbpos_clip_to_bounds (BUF_BEGV (buf), - old_point, - BUF_ZV (buf)); - BUF_SET_PT (buf, old_point); - + unbind_to (spec); UNGCPRO; } return nchars; @@ -1499,48 +1488,24 @@ exec_sentinel (process, msg); /* Don't bother with a message in the buffer when a process becomes runnable. */ - else if (!EQ (symbol, Qrun) && !NILP (p->buffer)) + else if (!EQ (symbol, Qrun) && !NILP (p->buffer) && + /* Avoid error if buffer is deleted + (probably that's why the process is dead, too) */ + BUFFER_LIVE_P (XBUFFER (p->buffer))) { - Lisp_Object old_read_only = Qnil; - Lisp_Object old = Fcurrent_buffer (); - Charbpos opoint; - struct gcpro ngcpro1, ngcpro2; - - /* Avoid error if buffer is deleted - (probably that's why the process is dead, too) */ - if (!BUFFER_LIVE_P (XBUFFER (p->buffer))) - continue; + struct gcpro ngcpro1; + struct buffer *buf = XBUFFER (p->buffer); + int spec = process_setup_for_insertion (process); - NGCPRO2 (old, old_read_only); - Fset_buffer (p->buffer); - opoint = BUF_PT (current_buffer); - /* Insert new output into buffer - at the current end-of-output marker, - thus preserving logical ordering of input and output. */ - if (XMARKER (p->mark)->buffer) - BUF_SET_PT (current_buffer, marker_position (p->mark)); - else - BUF_SET_PT (current_buffer, BUF_ZV (current_buffer)); - if (BUF_PT (current_buffer) <= opoint) - opoint += (string_char_length (msg) - + string_char_length (p->name) - + 10); - - old_read_only = current_buffer->read_only; - current_buffer->read_only = Qnil; + NGCPRO1 (process); buffer_insert_c_string (current_buffer, "\nProcess "); Finsert (1, &p->name); buffer_insert_c_string (current_buffer, " "); Finsert (1, &msg); - current_buffer->read_only = old_read_only; Fset_marker (p->mark, make_int (BUF_PT (current_buffer)), p->buffer); - opoint = charbpos_clip_to_bounds(BUF_BEGV (XBUFFER (p->buffer)), - opoint, - BUF_ZV (XBUFFER (p->buffer))); - BUF_SET_PT (current_buffer, opoint); - Fset_buffer (old); + unbind_to (spec); NUNGCPRO; } }
--- a/src/window.c Wed May 15 15:27:58 2002 +0000 +++ b/src/window.c Thu May 16 13:30:58 2002 +0000 @@ -212,6 +212,15 @@ } } +/* These caches map buffers to markers. They are key-weak so that entries + remain around as long as the buffers do. */ + +static Lisp_Object +make_saved_buffer_point_cache (void) +{ + return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); +} + DEFINE_LRECORD_IMPLEMENTATION ("window", window, mark_window, print_window, finalize_window, 0, 0, 0, struct window); @@ -248,6 +257,8 @@ INIT_DISP_VARIABLE (start, Fmake_marker ()); INIT_DISP_VARIABLE (pointm, Fmake_marker ()); p->sb_point = Fmake_marker (); + p->saved_point_cache = make_saved_buffer_point_cache (); + p->saved_last_window_start_cache = make_saved_buffer_point_cache (); p->use_time = Qzero; INIT_DISP_VARIABLE (last_modified, Qzero); INIT_DISP_VARIABLE (last_point, Fmake_marker ()); @@ -1757,14 +1768,20 @@ DEFUN ("set-window-point", Fset_window_point, 2, 2, 0, /* Make point value in WINDOW be at position POS in WINDOW's buffer. +If WINDOW is the selected window, this actually changes the buffer's point +instead of the window's point. (The equivalence of the selected window's +point with its buffer's point is maintained throughout XEmacs.) */ (window, pos)) { struct window *w = decode_window (window); CHECK_INT_COERCE_MARKER (pos); - if (w == XWINDOW (Fselected_window (Qnil))) - Fgoto_char (pos, Qnil); + /* Don't dereference selected-window because there may not + be one -- e.g. at startup */ + if (EQ (wrap_window (w), Fselected_window (Qnil))) + /* Even though window selected, buffer may not be current */ + Fgoto_char (pos, w->buffer); else set_marker_restricted (w->pointm[CURRENT_DISP], pos, w->buffer); @@ -1834,8 +1851,9 @@ unshow_buffer (struct window *w) { Lisp_Object buf = w->buffer; - - if (XBUFFER (buf) != XMARKER (w->pointm[CURRENT_DISP])->buffer) + struct buffer *b = XBUFFER (buf); + + if (b != XMARKER (w->pointm[CURRENT_DISP])->buffer) abort (); /* FSF disables this check, so I'll do it too. I hope it won't @@ -1860,12 +1878,34 @@ 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)) - { - struct buffer *b= XBUFFER (buf); - BUF_SET_PT (b, charbpos_clip_to_bounds (BUF_BEGV (b), - marker_position (w->pointm[CURRENT_DISP]), - BUF_ZV (b))); - } + BUF_SET_PT (b, + charbpos_clip_to_bounds + (BUF_BEGV (b), + marker_position (w->pointm[CURRENT_DISP]), + BUF_ZV (b))); + + { + Lisp_Object marker = Fgethash (buf, w->saved_point_cache, Qnil); + int selected = EQ (wrap_window (w), Fselected_window (Qnil)); + + if (NILP (marker)) + { + marker = Fmake_marker (); + Fputhash (buf, marker, w->saved_point_cache); + } + Fset_marker (marker, + selected ? make_int (BUF_PT (b)) : 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); + } } /* Put REPLACEMENT into the window structure in place of OLD. */ @@ -3490,17 +3530,44 @@ 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_int (BUF_PT (XBUFFER (buffer))), buffer); set_marker_restricted (w->start[CURRENT_DISP], make_int (XBUFFER (buffer)->last_window_start), buffer); +#else + { + Lisp_Object marker = Fgethash (buffer, w->saved_point_cache, Qnil); + Lisp_Object newpoint = + !NILP (marker) ? make_int (marker_position (marker)) : + make_int (BUF_PT (XBUFFER (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_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_int (marker_position (marker)) : + make_int (XBUFFER (buffer)->last_window_start), + buffer); + } +#endif + Fset_marker (w->sb_point, w->start[CURRENT_DISP], buffer); /* set start_at_line_beg correctly. GE */ - w->start_at_line_beg = beginning_of_line_p (XBUFFER (buffer), - marker_position (w->start[CURRENT_DISP])); - w->force_start = 0; /* Lucid fix */ + w->start_at_line_beg = + beginning_of_line_p (XBUFFER (buffer), + marker_position (w->start[CURRENT_DISP])); + w->force_start = 0; /* XEmacs fix */ SET_LAST_MODIFIED (w, 1); SET_LAST_FACECHANGE (w); MARK_WINDOWS_CHANGED (w); @@ -3687,6 +3754,8 @@ p->pointm[DESIRED_DISP] = Qnil; p->pointm[CMOTION_DISP] = Qnil; p->sb_point = Qnil; + p->saved_point_cache = make_saved_buffer_point_cache (); + p->saved_last_window_start_cache = make_saved_buffer_point_cache (); p->buffer = Qnil; } @@ -4429,14 +4498,7 @@ MARK_WINDOWS_CHANGED (w); if (!point_would_be_visible (w, startp, XINT (point))) - { - if (selected) - BUF_SET_PT (b, startp); - else - set_marker_restricted (w->pointm[CURRENT_DISP], - make_int (startp), - w->buffer); - } + Fset_window_point (wrap_window (w), make_int (startp)); } } } @@ -4512,12 +4574,7 @@ else new_point = start_of_last_line (w, startp); - if (selected) - BUF_SET_PT (b, new_point); - else - set_marker_restricted (w->pointm[CURRENT_DISP], - make_int (new_point), - w->buffer); + Fset_window_point (wrap_window (w), make_int (new_point)); } } } @@ -4557,12 +4614,7 @@ { Charbpos new_point = start_of_last_line (w, startp); - if (selected) - BUF_SET_PT (b, new_point); - else - set_marker_restricted (w->pointm[CURRENT_DISP], - make_int (new_point), - w->buffer); + Fset_window_point (wrap_window (w), make_int (new_point)); } } } @@ -4775,6 +4827,9 @@ { new_point = point_at_center (w, CURRENT_DISP, 0, 0); + /* #### Here we are checking the selected window of the frame + instead of the selected window period. Elsewhere we check + the selected window of the device. What a mess! */ if (selected) BUF_SET_PT (b, new_point); else
--- a/src/winslots.h Wed May 15 15:27:58 2002 +0000 +++ b/src/winslots.h Thu May 16 13:30:58 2002 +0000 @@ -1,7 +1,7 @@ /* Definitions of marked slots in windows and window configs Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2001 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. @@ -28,7 +28,9 @@ NOTE: No semicolons after slot declarations in this file! The definitions of WINDOW_SLOT (and possibly WINDOW_SAVED_SLOT) need - to include a semicolon. + to include a semicolon. This is because these may be defined as + nothing, and some compilers don't tolerate extra semicolons in + structure definitions. WINDOW_SLOT declares a Lisp_Object that is not copied into the saved_window struct of a window configuration, or is handled in @@ -110,6 +112,20 @@ /* 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. */ + 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 + the previous table. */ + WINDOW_SLOT (saved_last_window_start_cache) /* Number saying how recently window was selected */ WINDOW_SLOT (use_time)