comparison lisp/simple.el @ 502:7039e6323819

[xemacs-hg @ 2001-05-04 22:41:46 by ben] ----------------------- byte-comp warning fixes ----------------- New functions for cleanly eliminating byte-compiler warnings. Their definitions require no changes at all in bytecomp.el, meaning that any package that wants to use them and be compatible with older versions of XEmacs need only copy the code and rename the functions (i.e. prefix them with the package name). Eliminate byte-compiler warnings using the new functions in bytecomp-runtime.el. Move coding-system-put,get,category, since they're not Mule-specific and are used in prefer-coding-system. font.el was incredibly ugly. Clean it up. Avoid using defsubst for any exported functions, to avoid possible compatibility problems if we later change the internal interface. (It happened before, with face accessors, between 19.8 and 19.9). Fix tons of warnings. Clean up (new function gpm-is-supported-p eliminates duplicate code in gpm-create/delete-device-hook) and eliminate warnings. ---------- make byte-recompile-directory work in the --------- core `lisp' dir, even in the absence of a Mule XEmacs (i.e. make it skip the Mule files rather than trying to compile them). now you should be able to do `touch *.el' in the `lisp' dir, then M-x byte-recompile-directory, and get no warnings. Avoid trying to compile Mule files in byte-recompile-directory when we're not in a Mule XEmacs, since we're highly likely to get syntax errors. Add a coding-system cookie to all Mule files so that byte-recompile-directory ignores them. Magic cookie function moved to files.el from code-files.el (for use by bytecomp even in a non-coding-system XEmacs), and changed names and semantics for use by bytecomp. NOTE: IMO this is an internal function that we can change as we like (and there is absolutely no code anywhere else using the function). ---------------- GUI improvements: menus, help ------------------- Rearrange order of keymap declarations to be alphabetical. Improve help on help to include all bindings, and group by category. Add bindings for new Info commands. Remove warnings. Use command-hyper-apropos in place of command-apropos. Add a function to do the equivalent of command-apropos. Evals its help-text argument so you can put expressions there. Used now by help-for-help. Add binding to continue text searches. Expand index searches to work over multiple info documents. Add commands to search text/index in User and Lispref. Add new entry, "Uncomment Region" (parallels "Comment Out Region"). Redo Help menu; add bindings for new Info commands to search the index or text of the User and Lispref manuals. Add command for mark-paragraph, activate-region. Make Edit->R accelerator be rectangle, not register (more commonly used), and put rectangle first. Fix the Edit Init File entry to never load the .elc file. Simplify the default-popup-menu. Add Cmds->Tabs menu. Use kp-left not kp_left, etc. ---------------- Miscellaneous bug fixes/cleanup ------------------- byte-compiler-options: Correct doc string. easy-menu-do-define: fix extra quote. fill-paragraph-or-region:Rewrite to be more correct -- use call-interactively so that we always get exactly the same behavior as if the functions were called directly. No need to fiddle with zmacs-region-stays, now that bogus clearing of it (2001-04-28 src/ChangeLog) is removed. Put dialog titles back in -- this time correctly. Fix various other problems with leaks and such. key-sequence-list-description: Clean up fun to always correctly canonicalize. Clean up Kinsoku comments, synch comment-region with FSF 20.7. * simple.el (region-exists-p): * simple.el (region-active-p): Add comment about which one is correct to use in menu specs. * sound.el (load-sound-file): Minor code clean up. * startup.el: * startup.el (command-line-early): * startup.el (initial-scratch-message): Comment changes. Add info about sample.init.el to splash screen. Improve initial-scratch-message and clarify purpose of Scratch buffer. Fix byte-compile warning. ------------------------ Added features ------------------------- Add new variable to control whether etags checks all parent directories for tag files. (On by default.) * hash-table.el: New file, useful utility functions. * dumped-lisp.el (preloaded-file-list): Dump hash-table.el. ------------ notable bug fix: Windows event code -------------- Get critical quit working. ------------ notable bug fix and new feature: regex code -------------- Shy groups were implemented in a horrible, half-assed way that would cause them to screw up regex searching in most cases. Fixed to work correctly. Also extended back-reference syntax past 9. Only is recognized as such if there are at least that many non-shy groups; and optionally will warn about such uses, to catch old code that might be using them differently. (Added variable to control this in search.c -- `warn-about-possibly-incompatible-back- references', on by default for the moment. Declared in lisp.h. ---------------- process/SIGIO improvements ------------------- define USE_GETADDRINFO to replace more complex conditional, and use it. the code conditionalized on this in unix_open_network_stream had *serious* problems handling errors. it's now fixed, and major amounts of duplicate code between the two versions were combined. don't disable SIGIO and other interrupts unless CONNECT_NEEDS_SLOWED_INTERRUPTS is defined -- don't penalize OS's without bugs. similarly for a freebsd bug that was affecting all OS's. * s\ultrix.h: define CONNECT_NEEDS_SLOWED_INTERRUPTS, since that's the OS mentioned as having a kernel bug. * sysdep.c (request_sigio_on_device): * sysdep.c (unrequest_sigio_on_device): fix SIGIO problems on Linux. add check for O_ASYNC in case it's defined and FASYNC isn't. add comment about other ways to do SIGIO on Linux. * callproc.c (Fold_call_process_internal): * process.c (Fstart_process_internal): Deal with the possibility that `default-directory' doesn't have terminating slash. Correct comments about vfork. ---------------- Miscellaneous bug fixes/cleanup ------------------- * callint.c (Finteractive): Add lots of documentation -- exactly what the Lisp equivalents of all the interactive specs are. * console.h (struct console): change type of quit_char to Emchar. * event-msw.c (lstream_type_create_mswindows_selectable): spacing change. Eliminate events-mod.h and combine into events.h. * emacs.c: * emacs.c (make_arg_list_1): * emacs.c (main_1): A couple of char->Extbyte changes, add a comment. * glyphs-msw.c: Correct indentation of function defns to not exceed 80 cols. Try (sort of) to fix some code that sets the colors of the progress gauge. (Commented out) * keymap.c (syms_of_keymap): use DEFSYMBOL. * process.c (read_process_output): No need to fiddle with zmacs_region_stays, now that bogus clearing of it (see below) is removed. * search.c (Freplace_match): warning fix.
author ben
date Fri, 04 May 2001 22:42:35 +0000
parents 54fa1a5c2d12
children 98fb34b6fbe9
comparison
equal deleted inserted replaced
501:0a255b32b157 502:7039e6323819
56 ;; argument, meaning "don't activate the region". These commands only use 56 ;; argument, meaning "don't activate the region". These commands only use
57 ;; exchange-point-and-mark to position the newly-pushed mark correctly, so 57 ;; exchange-point-and-mark to position the newly-pushed mark correctly, so
58 ;; this isn't a user-visible change. These functions have also been altered 58 ;; this isn't a user-visible change. These functions have also been altered
59 ;; to use (mark t) for the same reason. 59 ;; to use (mark t) for the same reason.
60 60
61 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing (support 61 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing
62 ;; for filling of Asian text) into the fill code. This was ripped bleeding from 62 ;; (support for filling of Asian text) into the fill code. This was
63 ;; Mule-2.3, and could probably use some feature additions (like additional wrap 63 ;; ripped bleeding from Mule-2.3, and could probably use some feature
64 ;; styles, etc) 64 ;; additions (like additional wrap styles, etc)
65 65
66 ;; 97/06/11 Steve Baur (steve@xemacs.org) Convert use of 66 ;; 97/06/11 Steve Baur (steve@xemacs.org) Convert use of
67 ;; (preceding|following)-char to char-(after|before). 67 ;; (preceding|following)-char to char-(after|before).
68 68
69 ;;; Code: 69 ;;; Code:
451 451
452 ;; Trash me, baby. 452 ;; Trash me, baby.
453 (defsubst delete-forward-p () 453 (defsubst delete-forward-p ()
454 (and delete-key-deletes-forward 454 (and delete-key-deletes-forward
455 (or (not (eq (device-type) 'x)) 455 (or (not (eq (device-type) 'x))
456 (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))) 456 (declare-fboundp
457 (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))))
457 458
458 (defun backward-or-forward-delete-char (arg) 459 (defun backward-or-forward-delete-char (arg)
459 "Delete either one character backwards or one character forwards. 460 "Delete either one character backwards or one character forwards.
460 Controlled by the state of `delete-key-deletes-forward' and whether the 461 Controlled by the state of `delete-key-deletes-forward' and whether the
461 BackSpace keysym even exists on your keyboard. If you don't have a 462 BackSpace keysym even exists on your keyboard. If you don't have a
2789 ;; to catch comments a line beginnings 2790 ;; to catch comments a line beginnings
2790 (indent-according-to-mode)))) 2791 (indent-according-to-mode))))
2791 (if arg (forward-line 1)) 2792 (if arg (forward-line 1))
2792 (setq count (1- count))))) 2793 (setq count (1- count)))))
2793 2794
2795 ;; This variable: Synched up with 20.7.
2796 (defvar comment-padding 1
2797 "Number of spaces `comment-region' puts between comment chars and text.
2798
2799 Extra spacing between the comment characters and the comment text
2800 makes the comment easier to read. Default is 1. Nil means 0 and is
2801 more efficient.")
2802
2803 ;; This function: Synched up with 20.7.
2794 (defun comment-region (start end &optional arg) 2804 (defun comment-region (start end &optional arg)
2795 "Comment or uncomment each line in the region. 2805 "Comment or uncomment each line in the region.
2796 With just C-u prefix arg, uncomment each line in region. 2806 With just C-u prefix arg, uncomment each line in region.
2797 Numeric prefix arg ARG means use ARG comment characters. 2807 Numeric prefix arg ARG means use ARG comment characters.
2798 If ARG is negative, delete that many comment characters instead. 2808 If ARG is negative, delete that many comment characters instead.
2806 (or comment-start (error "No comment syntax is defined")) 2816 (or comment-start (error "No comment syntax is defined"))
2807 (if (> start end) (let (mid) (setq mid start start end end mid))) 2817 (if (> start end) (let (mid) (setq mid start start end end mid)))
2808 (save-excursion 2818 (save-excursion
2809 (save-restriction 2819 (save-restriction
2810 (let ((cs comment-start) (ce comment-end) 2820 (let ((cs comment-start) (ce comment-end)
2821 (cp (when comment-padding
2822 (make-string comment-padding ? )))
2811 numarg) 2823 numarg)
2812 (if (consp arg) (setq numarg t) 2824 (if (consp arg) (setq numarg t)
2813 (setq numarg (prefix-numeric-value arg)) 2825 (setq numarg (prefix-numeric-value arg))
2814 ;; For positive arg > 1, replicate the comment delims now, 2826 ;; For positive arg > 1, replicate the comment delims now,
2815 ;; then insert the replicated strings just once. 2827 ;; then insert the replicated strings just once.
2818 ce (concat ce comment-end)) 2830 ce (concat ce comment-end))
2819 (setq numarg (1- numarg)))) 2831 (setq numarg (1- numarg))))
2820 ;; Loop over all lines from START to END. 2832 ;; Loop over all lines from START to END.
2821 (narrow-to-region start end) 2833 (narrow-to-region start end)
2822 (goto-char start) 2834 (goto-char start)
2823 (while (not (eobp)) 2835 ;; if user didn't specify how many comments to remove, be smart
2824 (if (or (eq numarg t) (< numarg 0)) 2836 ;; and remove the minimal number that all lines have. that way,
2825 (progn 2837 ;; comments in a region of Elisp code that gets commented out will
2838 ;; get put back correctly.
2839 (if (eq numarg t)
2840 (let ((min-comments 999999))
2841 (while (not (eobp))
2842 (let ((this-comments 0))
2843 (while (looking-at (regexp-quote cs))
2844 (incf this-comments)
2845 (forward-char (length cs)))
2846 (if (and (> this-comments 0) (< this-comments min-comments))
2847 (setq min-comments this-comments))
2848 (forward-line 1)))
2849 (if (< min-comments 999999)
2850 (setq numarg (- min-comments)))
2851 (goto-char start)))
2852 (if (or (eq numarg t) (< numarg 0))
2853 (while (not (eobp))
2854 (let (found-comment)
2826 ;; Delete comment start from beginning of line. 2855 ;; Delete comment start from beginning of line.
2827 (if (eq numarg t) 2856 (if (eq numarg t)
2828 (while (looking-at (regexp-quote cs)) 2857 (while (looking-at (regexp-quote cs))
2858 (setq found-comment t)
2829 (delete-char (length cs))) 2859 (delete-char (length cs)))
2830 (let ((count numarg)) 2860 (let ((count numarg))
2831 (while (and (> 1 (setq count (1+ count))) 2861 (while (and (> 1 (setq count (1+ count)))
2832 (looking-at (regexp-quote cs))) 2862 (looking-at (regexp-quote cs)))
2863 (setq found-comment t)
2833 (delete-char (length cs))))) 2864 (delete-char (length cs)))))
2865 ;; Delete comment padding from beginning of line
2866 (when (and found-comment comment-padding
2867 (looking-at (regexp-quote cp)))
2868 (delete-char comment-padding))
2834 ;; Delete comment end from end of line. 2869 ;; Delete comment end from end of line.
2835 (if (string= "" ce) 2870 (if (string= "" ce)
2836 nil 2871 nil
2837 (if (eq numarg t) 2872 (if (eq numarg t)
2838 (progn 2873 (progn
2839 (end-of-line) 2874 (end-of-line)
2840 ;; This is questionable if comment-end ends in 2875 ;; This is questionable if comment-end ends in
2841 ;; whitespace. That is pretty brain-damaged, 2876 ;; whitespace. That is pretty brain-damaged,
2842 ;; though. 2877 ;; though.
2843 (skip-chars-backward " \t") 2878 (while (progn (skip-chars-backward " \t")
2844 (if (and (>= (- (point) (point-min)) (length ce)) 2879 (and (>= (- (point) (point-min))
2845 (save-excursion 2880 (length ce))
2846 (backward-char (length ce)) 2881 (save-excursion
2847 (looking-at (regexp-quote ce)))) 2882 (backward-char (length ce))
2848 (delete-char (- (length ce))))) 2883 (looking-at (regexp-quote ce)))))
2884 (delete-char (- (length ce)))))
2849 (let ((count numarg)) 2885 (let ((count numarg))
2850 (while (> 1 (setq count (1+ count))) 2886 (while (> 1 (setq count (1+ count)))
2851 (end-of-line) 2887 (end-of-line)
2852 ;; This is questionable if comment-end ends in 2888 ;; This is questionable if comment-end ends in
2853 ;; whitespace. That is pretty brain-damaged though 2889 ;; whitespace. That is pretty brain-damaged though
2854 (skip-chars-backward " \t") 2890 (skip-chars-backward " \t")
2855 (save-excursion 2891 (if (>= (- (point) (point-min)) (length ce))
2856 (backward-char (length ce)) 2892 (save-excursion
2857 (if (looking-at (regexp-quote ce)) 2893 (backward-char (length ce))
2858 (delete-char (length ce)))))))) 2894 (if (looking-at (regexp-quote ce))
2859 (forward-line 1)) 2895 (delete-char (length ce)))))))))
2896 (forward-line 1)))
2897
2898 (when comment-padding
2899 (setq cs (concat cs cp)))
2900 (while (not (eobp))
2860 ;; Insert at beginning and at end. 2901 ;; Insert at beginning and at end.
2861 (if (looking-at "[ \t]*$") () 2902 (if (looking-at "[ \t]*$") ()
2862 (insert cs) 2903 (insert cs)
2863 (if (string= "" ce) () 2904 (if (string= "" ce) ()
2864 (end-of-line) 2905 (end-of-line)
2987 ;; Determine where to split the line. 3028 ;; Determine where to split the line.
2988 (let ((fill-prefix fill-prefix) 3029 (let ((fill-prefix fill-prefix)
2989 (fill-point 3030 (fill-point
2990 (let ((opoint (point)) 3031 (let ((opoint (point))
2991 bounce 3032 bounce
2992 ;; 97/3/14 jhod: Kinsoku 3033 (re-break-point ;; Kinsoku processing
2993 (re-break-point (if (featurep 'mule) 3034 (if (featurep 'mule)
2994 (concat "[ \t\n]\\|" word-across-newline 3035 (concat "[ \t\n]\\|" word-across-newline
2995 ".\\|." word-across-newline) 3036 ".\\|." word-across-newline)
2996 "[ \t\n]")) 3037 "[ \t\n]"))
2997 ;; end patch
2998 (first t)) 3038 (first t))
2999 (save-excursion 3039 (save-excursion
3000 (move-to-column (1+ fill-column)) 3040 (move-to-column (1+ fill-column))
3001 ;; Move back to a word boundary. 3041 ;; Move back to a word boundary.
3002 (while (or first 3042 (while (or first
3009 sentence-end-double-space 3049 sentence-end-double-space
3010 (save-excursion (backward-char 1) 3050 (save-excursion (backward-char 1)
3011 (and (looking-at "\\. ") 3051 (and (looking-at "\\. ")
3012 (not (looking-at "\\. ")))))) 3052 (not (looking-at "\\. "))))))
3013 (setq first nil) 3053 (setq first nil)
3014 ;; 97/3/14 jhod: Kinsoku 3054 ;; XEmacs: change for Kinsoku processing
3015 ; (skip-chars-backward "^ \t\n"))
3016 (fill-move-backward-to-break-point re-break-point) 3055 (fill-move-backward-to-break-point re-break-point)
3017 ;; end patch
3018 ;; If we find nowhere on the line to break it, 3056 ;; If we find nowhere on the line to break it,
3019 ;; break after one word. Set bounce to t 3057 ;; break after one word. Set bounce to t
3020 ;; so we will not keep going in this while loop. 3058 ;; so we will not keep going in this while loop.
3021 (if (bolp) 3059 (if (bolp)
3022 (progn 3060 (progn
3023 ;; 97/3/14 jhod: Kinsoku 3061 ;; XEmacs: change for Kinsoku processing
3024 ; (re-search-forward "[ \t]" opoint t)
3025 (fill-move-forward-to-break-point re-break-point 3062 (fill-move-forward-to-break-point re-break-point
3026 opoint) 3063 opoint)
3027 ;; end patch
3028 (setq bounce t))) 3064 (setq bounce t)))
3029 (skip-chars-backward " \t")) 3065 (skip-chars-backward " \t"))
3030 (if (and (featurep 'mule) 3066 (if (and (featurep 'mule)
3031 (or bounce (bolp))) (kinsoku-process)) ;; 97/3/14 jhod: Kinsoku 3067 (or bounce (bolp)))
3068 (declare-fboundp (kinsoku-process)))
3032 ;; Let fill-point be set to the place where we end up. 3069 ;; Let fill-point be set to the place where we end up.
3033 (point))))) 3070 (point)))))
3034 3071
3035 ;; I'm not sure why Stig made this change but it breaks 3072 ;; I'm not sure why Stig made this change but it breaks
3036 ;; auto filling in at least C mode so I'm taking it back 3073 ;; auto filling in at least C mode so I'm taking it back
3045 3082
3046 ;; If that place is not the beginning of the line, 3083 ;; If that place is not the beginning of the line,
3047 ;; break the line there. 3084 ;; break the line there.
3048 (if (save-excursion 3085 (if (save-excursion
3049 (goto-char fill-point) 3086 (goto-char fill-point)
3050 (not (or (bolp) (eolp)))) ; 97/3/14 jhod: during kinsoku processing it is possible to move beyond 3087 ;; during kinsoku processing it is possible to move beyond
3088 (not (or (bolp) (eolp))))
3051 (let ((prev-column (current-column))) 3089 (let ((prev-column (current-column)))
3052 ;; If point is at the fill-point, do not `save-excursion'. 3090 ;; If point is at the fill-point, do not `save-excursion'.
3053 ;; Otherwise, if a comment prefix or fill-prefix is inserted, 3091 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3054 ;; point will end up before it rather than after it. 3092 ;; point will end up before it rather than after it.
3055 (if (save-excursion 3093 (if (save-excursion
3056 (skip-chars-backward " \t") 3094 (skip-chars-backward " \t")
3057 (= (point) fill-point)) 3095 (= (point) fill-point))
3058 ;; 1999-09-17 hniksic: turn off Kinsoku until 3096 ;; 1999-09-17 hniksic: turn off Kinsoku until
3059 ;; it's debugged. 3097 ;; it's debugged.
3060 (funcall comment-line-break-function) 3098 (funcall comment-line-break-function)
3061 ;; 97/3/14 jhod: Kinsoku processing 3099 ;; XEmacs: Kinsoku processing
3062 ; ;(indent-new-comment-line) 3100 ; ;(indent-new-comment-line)
3063 ; (let ((spacep (memq (char-before (point)) '(?\ ?\t)))) 3101 ; (let ((spacep (memq (char-before (point)) '(?\ ?\t))))
3064 ; (funcall comment-line-break-function) 3102 ; (funcall comment-line-break-function)
3065 ; ;; if user type space explicitly, leave SPC 3103 ; ;; if user type space explicitly, leave SPC
3066 ; ;; even if there is no WAN. 3104 ; ;; even if there is no WAN.
3246 The inserted newline is marked hard if `use-hard-newlines' is true, 3284 The inserted newline is marked hard if `use-hard-newlines' is true,
3247 unless optional argument SOFT is non-nil." 3285 unless optional argument SOFT is non-nil."
3248 (interactive) 3286 (interactive)
3249 (let (comcol comstart) 3287 (let (comcol comstart)
3250 (skip-chars-backward " \t") 3288 (skip-chars-backward " \t")
3251 ;; 97/3/14 jhod: Kinsoku processing
3252 (if (featurep 'mule) 3289 (if (featurep 'mule)
3253 (kinsoku-process)) 3290 (declare-fboundp (kinsoku-process)))
3254 (delete-region (point) 3291 (delete-region (point)
3255 (progn (skip-chars-forward " \t") 3292 (progn (skip-chars-forward " \t")
3256 (point))) 3293 (point)))
3257 (if soft (insert ?\n) (newline 1)) 3294 (if soft (insert ?\n) (newline 1))
3258 (if fill-prefix 3295 (if fill-prefix
3866 "Return t if the region exists. 3903 "Return t if the region exists.
3867 If active regions are in use (i.e. `zmacs-regions' is true), this means that 3904 If active regions are in use (i.e. `zmacs-regions' is true), this means that
3868 the region is active. Otherwise, this means that the user has pushed 3905 the region is active. Otherwise, this means that the user has pushed
3869 a mark in this buffer at some point in the past. 3906 a mark in this buffer at some point in the past.
3870 The functions `region-beginning' and `region-end' can be used to find the 3907 The functions `region-beginning' and `region-end' can be used to find the
3871 limits of the region." 3908 limits of the region.
3909
3910 You should use this, *NOT* `region-active-p', in a menu item
3911 specification that you want grayed out when the region is not active:
3912
3913 [ ... ... :active (region-exists-p)]
3914
3915 This correctly caters to the user's setting of `zmacs-regions'."
3872 (not (null (mark)))) 3916 (not (null (mark))))
3873 3917
3874 ;; XEmacs 3918 ;; XEmacs
3875 (defun region-active-p () 3919 (defun region-active-p ()
3876 "Return non-nil if the region is active. 3920 "Return non-nil if the region is active.
3877 If `zmacs-regions' is true, this is equivalent to `region-exists-p'. 3921 If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
3878 Otherwise, this function always returns false." 3922 Otherwise, this function always returns false.
3923
3924 You should generally *NOT* use this in a menu item specification that you
3925 want grayed out when the region is not active. Instead, use this:
3926
3927 [ ... ... :active (region-exists-p)]
3928
3929 Which correctly caters to the user's setting of `zmacs-regions'."
3879 (and zmacs-regions zmacs-region-extent)) 3930 (and zmacs-regions zmacs-region-extent))
3880 3931
3881 (defvar zmacs-activate-region-hook nil 3932 (defvar zmacs-activate-region-hook nil
3882 "Function or functions called when the region becomes active; 3933 "Function or functions called when the region becomes active;
3883 see the variable `zmacs-regions'.") 3934 see the variable `zmacs-regions'.")
4214 Unless you need the return value or you need to specify a label, 4265 Unless you need the return value or you need to specify a label,
4215 you should just use (message nil)." 4266 you should just use (message nil)."
4216 (or frame (setq frame (selected-frame))) 4267 (or frame (setq frame (selected-frame)))
4217 (let ((clear-stream (and message-stack (eq 'stream (frame-type frame))))) 4268 (let ((clear-stream (and message-stack (eq 'stream (frame-type frame)))))
4218 (remove-message label frame) 4269 (remove-message label frame)
4219 (let ((inhibit-read-only t) 4270 (let ((inhibit-read-only t))
4220 (zmacs-region-stays zmacs-region-stays)) ; preserve from change
4221 (erase-buffer " *Echo Area*")) 4271 (erase-buffer " *Echo Area*"))
4222 (if clear-stream 4272 (if clear-stream
4223 (send-string-to-terminal ?\n stdout-p)) 4273 (send-string-to-terminal ?\n stdout-p))
4224 (if no-restore 4274 (if no-restore
4225 nil ; just preparing to put another msg up 4275 nil ; just preparing to put another msg up
4273 4323
4274 ;; Really append the message to the echo area. no fiddling with 4324 ;; Really append the message to the echo area. no fiddling with
4275 ;; message-stack. 4325 ;; message-stack.
4276 (defun raw-append-message (message &optional frame stdout-p) 4326 (defun raw-append-message (message &optional frame stdout-p)
4277 (unless (equal message "") 4327 (unless (equal message "")
4278 (let ((inhibit-read-only t) 4328 (let ((inhibit-read-only t))
4279 (zmacs-region-stays zmacs-region-stays)) ; preserve from change
4280 (insert-string message " *Echo Area*") 4329 (insert-string message " *Echo Area*")
4281 ;; Conditionalizing on the device type in this way is not that clean, 4330 ;; Conditionalizing on the device type in this way is not that clean,
4282 ;; but neither is having a device method, as I originally implemented 4331 ;; but neither is having a device method, as I originally implemented
4283 ;; it: all non-stream devices behave in the same way. Perhaps 4332 ;; it: all non-stream devices behave in the same way. Perhaps
4284 ;; the cleanest way is to make the concept of a "redisplayable" 4333 ;; the cleanest way is to make the concept of a "redisplayable"