Mercurial > hg > xemacs-beta
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" |