Mercurial > hg > xemacs-beta
annotate lisp/indent.el @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | 5b560b7374ff |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 ;;; indent.el --- indentation commands for XEmacs |
| 2 | |
| 3 ;; Copyright (C) 1985, 1992, 1993, 1995, 1997 Free Software Foundation, Inc. | |
| 814 | 4 ;; Copyright (C) 2002 Ben Wing. |
| 428 | 5 |
| 6 ;; Maintainer: FSF | |
| 7 ;; Keywords: lisp, languages, tools, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 12 ;; under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 24 ;; 02111-1307, USA. | |
| 25 | |
| 26 ;;; Synched up with: FSF 19.30. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;; Commands for making and changing indentation in text. These are | |
| 33 ;; described in the XEmacs Reference Manual. | |
| 34 | |
| 35 ;; 06/11/1997 - Convert (preceding|following)-char to char-(before|after) -slb | |
| 36 | |
| 37 ;;; Code: | |
| 38 | |
| 39 (defvar standard-indent 4 "\ | |
| 40 Default number of columns for margin-changing functions to indent.") | |
| 41 | |
| 42 (defvar indent-line-function 'indent-to-left-margin | |
| 43 "Function to indent current line.") | |
| 44 | |
| 45 (defun indent-according-to-mode () | |
| 46 "Indent line in proper way for current major mode." | |
| 47 (interactive) | |
| 48 (funcall indent-line-function)) | |
| 49 | |
| 50 (defun indent-for-tab-command (&optional prefix-arg) | |
| 51 "Indent line in proper way for current major mode." | |
| 52 (interactive "P") | |
| 53 (if (eq indent-line-function 'indent-to-left-margin) | |
| 54 (insert-tab prefix-arg) | |
| 55 (if prefix-arg | |
| 56 (funcall indent-line-function prefix-arg) | |
| 57 (funcall indent-line-function)))) | |
| 58 | |
| 59 (defun insert-tab (&optional prefix-arg) | |
| 60 (let ((count (prefix-numeric-value prefix-arg))) | |
| 61 (if abbrev-mode | |
| 62 (expand-abbrev)) | |
| 63 (if indent-tabs-mode | |
| 64 (insert-char ?\t count) | |
| 65 ;; XEmacs: (Need the `1+') | |
| 66 (indent-to (* tab-width (1+ (/ (current-column) tab-width))))))) | |
| 67 | |
| 444 | 68 (defun indent-rigidly (start end count) |
| 69 "Indent all lines starting in the region sideways by COUNT columns. | |
| 70 Called from a program, takes three arguments, START, END and COUNT." | |
| 428 | 71 (interactive "r\np") |
| 72 (save-excursion | |
| 73 (goto-char end) | |
| 74 (setq end (point-marker)) | |
| 75 (goto-char start) | |
| 76 (or (bolp) (forward-line 1)) | |
| 77 (while (< (point) end) | |
| 78 (let ((indent (current-indentation)) | |
| 79 eol-flag) | |
| 80 (save-excursion | |
| 81 (skip-chars-forward " \t") | |
| 82 (setq eol-flag (eolp))) | |
| 83 (or eol-flag | |
| 444 | 84 (indent-to (max 0 (+ indent count)) 0)) |
| 428 | 85 (delete-region (point) (progn (skip-chars-forward " \t") (point)))) |
| 86 (forward-line 1)) | |
| 87 (move-marker end nil) | |
| 88 (setq zmacs-region-stays nil))) ; XEmacs | |
| 89 | |
| 90 (defun indent-line-to (column) | |
| 91 "Indent current line to COLUMN. | |
| 92 This function removes or adds spaces and tabs at beginning of line | |
| 93 only if necessary. It leaves point at end of indentation." | |
| 94 (back-to-indentation) | |
| 95 (let ((cur-col (current-column))) | |
| 96 (cond ((< cur-col column) | |
| 97 (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width) | |
| 98 (delete-region (point) | |
| 99 (progn (skip-chars-backward " ") (point)))) | |
| 100 (indent-to column)) | |
| 101 ((> cur-col column) ; too far right (after tab?) | |
| 102 (delete-region (progn (move-to-column column t) (point)) | |
| 103 (progn (back-to-indentation) (point))))))) | |
| 104 | |
| 105 (defun current-left-margin () | |
| 106 "Return the left margin to use for this line. | |
| 107 This is the value of the buffer-local variable `left-margin' plus the value | |
| 108 of the `left-margin' text-property at the start of the line." | |
| 109 (save-excursion | |
| 110 (back-to-indentation) | |
| 111 (max 0 | |
| 112 (+ left-margin (or (get-text-property | |
| 113 (if (and (eobp) (not (bobp))) | |
| 114 (1- (point)) (point)) | |
| 115 'left-margin) 0))))) | |
| 116 | |
| 117 (defun move-to-left-margin (&optional n force) | |
| 118 "Move to the left margin of the current line. | |
| 119 With optional argument, move forward N-1 lines first. | |
| 120 The column moved to is the one given by the `current-left-margin' function. | |
| 121 If the line's indentation appears to be wrong, and this command is called | |
| 122 interactively or with optional argument FORCE, it will be fixed." | |
| 123 (interactive (list (prefix-numeric-value current-prefix-arg) t)) | |
| 124 (beginning-of-line n) | |
| 125 (skip-chars-forward " \t") | |
| 126 (let ((lm (current-left-margin)) | |
| 127 (cc (current-column))) | |
| 128 (cond ((> cc lm) | |
| 129 (if (> (move-to-column lm force) lm) | |
| 130 ;; If lm is in a tab and we are not forcing, move before tab | |
| 131 (backward-char 1))) | |
| 132 ((and force (< cc lm)) | |
| 133 (indent-to-left-margin))))) | |
| 134 | |
| 135 ;; This is the default indent-line-function, | |
| 136 ;; used in Fundamental Mode, Text Mode, etc. | |
| 137 (defun indent-to-left-margin () | |
| 138 "Indent current line to the column given by `current-left-margin'." | |
| 139 (indent-line-to (current-left-margin))) | |
| 140 | |
| 141 (defun delete-to-left-margin (&optional from to) | |
| 142 "Remove left margin indentation from a region. | |
| 444 | 143 The amount of indentation to delete is determined by calling the |
| 144 function `current-left-margin'. | |
| 428 | 145 In no case will it delete non-whitespace. |
| 146 Args FROM and TO are optional; default is the whole buffer." | |
| 147 (save-excursion | |
| 148 (goto-char (or to (point-max))) | |
| 149 (setq to (point-marker)) | |
| 150 (goto-char (or from (point-min))) | |
| 151 (or (bolp) (forward-line 1)) | |
| 152 (while (< (point) to) | |
| 153 (delete-region (point) (progn (move-to-left-margin nil t) (point))) | |
| 154 (forward-line 1)) | |
| 155 (move-marker to nil))) | |
| 156 | |
| 157 (defun set-left-margin (from to lm) | |
| 158 "Set the left margin of the region to WIDTH. | |
| 159 If `auto-fill-mode' is active, re-fill the region to fit the new margin." | |
| 160 (interactive "r\nNSet left margin to column: ") | |
| 161 (if (interactive-p) (setq lm (prefix-numeric-value lm))) | |
| 162 (save-excursion | |
| 163 ;; If inside indentation, start from BOL. | |
| 164 (goto-char from) | |
| 165 (skip-chars-backward " \t") | |
| 166 (if (bolp) (setq from (point))) | |
| 167 ;; Place end after whitespace | |
| 168 (goto-char to) | |
| 169 (skip-chars-forward " \t") | |
| 170 (setq to (point-marker))) | |
| 171 ;; Delete margin indentation first, but keep paragraph indentation. | |
| 172 (delete-to-left-margin from to) | |
| 173 (put-text-property from to 'left-margin lm) | |
| 174 (indent-rigidly from to lm) | |
| 175 (if auto-fill-function (save-excursion (fill-region from to nil t t))) | |
| 176 (move-marker to nil)) | |
| 177 | |
| 178 (defun set-right-margin (from to lm) | |
| 179 "Set the right margin of the region to WIDTH. | |
| 180 If `auto-fill-mode' is active, re-fill the region to fit the new margin." | |
| 181 (interactive "r\nNSet right margin to width: ") | |
| 182 (if (interactive-p) (setq lm (prefix-numeric-value lm))) | |
| 183 (save-excursion | |
| 184 (goto-char from) | |
| 185 (skip-chars-backward " \t") | |
| 186 (if (bolp) (setq from (point)))) | |
| 187 (put-text-property from to 'right-margin lm) | |
| 188 (if auto-fill-function (save-excursion (fill-region from to nil t t)))) | |
| 189 | |
| 190 (defun alter-text-property (from to prop func &optional object) | |
| 191 "Programmatically change value of a text-property. | |
| 192 For each region between FROM and TO that has a single value for PROPERTY, | |
| 193 apply FUNCTION to that value and sets the property to the function's result. | |
| 194 Optional fifth argument OBJECT specifies the string or buffer to operate on." | |
| 195 (let ((begin from) | |
| 196 end val) | |
| 197 (while (setq val (get-text-property begin prop object) | |
| 198 end (text-property-not-all begin to prop val object)) | |
| 199 (put-text-property begin end prop (funcall func val) object) | |
| 200 (setq begin end)) | |
| 201 (if (< begin to) | |
| 202 (put-text-property begin to prop (funcall func val) object)))) | |
| 203 | |
| 204 (defun increase-left-margin (from to inc) | |
| 205 "Increase or decrease the left-margin of the region. | |
| 206 With no prefix argument, this adds `standard-indent' of indentation. | |
| 207 A prefix arg (optional third arg INC noninteractively) specifies the amount | |
| 208 to change the margin by, in characters. | |
| 209 If `auto-fill-mode' is active, re-fill the region to fit the new margin." | |
| 210 (interactive "*r\nP") | |
| 211 (setq inc (if inc (prefix-numeric-value inc) standard-indent)) | |
| 212 (save-excursion | |
| 213 (goto-char from) | |
| 214 (skip-chars-backward " \t") | |
| 215 (if (bolp) (setq from (point))) | |
| 216 (goto-char to) | |
| 217 (setq to (point-marker))) | |
| 218 (alter-text-property from (marker-position to) 'left-margin ; XEmacs | |
| 219 (lambda (v) (max (- left-margin) (+ inc (or v 0))))) | |
| 220 (indent-rigidly from (marker-position to) inc) ; XEmacs | |
| 221 (if auto-fill-function | |
| 222 (save-excursion | |
| 223 (fill-region from (marker-position to) nil t t))) ; XEmacs | |
| 224 (move-marker to nil)) | |
| 225 | |
| 226 (defun decrease-left-margin (from to inc) | |
| 227 "Make the left margin of the region smaller. | |
| 228 With no prefix argument, decrease the indentation by `standard-indent'. | |
| 229 A prefix arg (optional third arg INC noninteractively) specifies the amount | |
| 230 to change the margin by, in characters. | |
| 231 If `auto-fill-mode' is active, re-fill the region to fit the new margin." | |
| 232 (interactive "*r\nP") | |
| 233 (setq inc (if inc (prefix-numeric-value inc) standard-indent)) | |
| 234 (increase-left-margin from to (- inc))) | |
| 235 | |
| 236 (defun increase-right-margin (from to inc) | |
| 237 "Increase the right-margin of the region. | |
| 238 With no prefix argument, increase the right margin by `standard-indent'. | |
| 239 A prefix arg (optional third arg INC noninteractively) specifies the amount | |
| 240 to change the margin by, in characters. A negative argument decreases | |
| 241 the right margin width. | |
| 242 If `auto-fill-mode' is active, re-fill the region to fit the new margin." | |
| 243 (interactive "r\nP") | |
| 244 (if (interactive-p) | |
| 245 (setq inc (if inc (prefix-numeric-value current-prefix-arg) | |
| 246 standard-indent))) | |
| 247 (save-excursion | |
| 248 (alter-text-property from to 'right-margin | |
| 249 (lambda (v) (+ inc (or v 0)))) | |
| 250 (if auto-fill-function | |
| 251 (fill-region from to nil t t)))) | |
| 252 | |
| 253 (defun decrease-right-margin (from to inc) | |
| 254 "Make the right margin of the region smaller. | |
| 255 With no prefix argument, decrease the right margin by `standard-indent'. | |
| 256 A prefix arg (optional third arg INC noninteractively) specifies the amount | |
| 257 of width to remove, in characters. A negative argument increases | |
| 258 the right margin width. | |
| 259 If `auto-fill-mode' is active, re-fills region to fit in new margin." | |
| 260 (interactive "*r\nP") | |
| 261 (setq inc (if inc (prefix-numeric-value inc) standard-indent)) | |
| 262 (increase-right-margin from to (- inc))) | |
| 263 | |
| 264 (defun beginning-of-line-text (&optional n) | |
| 265 "Move to the beginning of the text on this line. | |
| 266 With optional argument, move forward N-1 lines first. | |
| 267 From the beginning of the line, moves past the left-margin indentation, the | |
| 268 fill-prefix, and any indentation used for centering or right-justifying the | |
| 444 | 269 line, but does not move past any whitespace that was explicitly inserted |
| 428 | 270 \(such as a tab used to indent the first line of a paragraph)." |
| 271 (interactive "p") | |
| 272 (beginning-of-line n) | |
| 273 (skip-chars-forward " \t") | |
| 274 ;; Skip over fill-prefix. | |
| 444 | 275 (if (and fill-prefix |
| 428 | 276 (not (string-equal fill-prefix ""))) |
| 277 (if (equal fill-prefix | |
| 444 | 278 (buffer-substring |
| 428 | 279 (point) (min (point-max) (+ (length fill-prefix) (point))))) |
| 280 (forward-char (length fill-prefix))) | |
| 281 (if (and adaptive-fill-mode adaptive-fill-regexp | |
| 282 (looking-at adaptive-fill-regexp)) | |
| 283 (goto-char (match-end 0)))) | |
| 284 ;; Skip centering or flushright indentation | |
| 285 (if (memq (current-justification) '(center right)) | |
| 286 (skip-chars-forward " \t"))) | |
| 287 | |
| 288 (defvar indent-region-function nil | |
| 289 "Short cut function to indent region using `indent-according-to-mode'. | |
| 290 A value of nil means really run `indent-according-to-mode' on each line.") | |
| 291 | |
|
4812
5b560b7374ff
Make COLUMN optional in #'indent-region, as in GNU.
Aidan Kehoe <kehoea@parhasard.net>
parents:
814
diff
changeset
|
292 (defun indent-region (start end &optional column) |
| 428 | 293 "Indent each nonblank line in the region. |
| 294 With no argument, indent each line using `indent-according-to-mode', | |
| 295 or use `indent-region-function' to do the whole region if that's non-nil. | |
| 296 If there is a fill prefix, make each line start with the fill prefix. | |
| 297 With argument COLUMN, indent each line to that column. | |
| 298 Called from a program, takes three args: START, END and COLUMN." | |
| 299 (interactive "r\nP") | |
| 300 (if (null column) | |
| 301 (if fill-prefix | |
| 302 (save-excursion | |
| 303 (goto-char end) | |
| 304 (setq end (point-marker)) | |
| 305 (goto-char start) | |
| 306 (let ((regexp (regexp-quote fill-prefix))) | |
| 307 (while (< (point) end) | |
| 308 (or (looking-at regexp) | |
| 309 (and (bolp) (eolp)) | |
| 310 (insert fill-prefix)) | |
| 311 (forward-line 1)))) | |
| 312 (if indent-region-function | |
| 313 (funcall indent-region-function start end) | |
| 314 (save-excursion | |
| 315 (goto-char end) | |
| 316 (setq end (point-marker)) | |
| 317 (goto-char start) | |
| 318 (or (bolp) (forward-line 1)) | |
| 319 (while (< (point) end) | |
| 320 (or (and (bolp) (eolp)) | |
| 321 (funcall indent-line-function)) | |
| 322 (forward-line 1)) | |
| 323 (move-marker end nil)))) | |
| 324 (setq column (prefix-numeric-value column)) | |
| 325 (save-excursion | |
| 326 (goto-char end) | |
| 327 (setq end (point-marker)) | |
| 328 (goto-char start) | |
| 329 (or (bolp) (forward-line 1)) | |
| 330 (while (< (point) end) | |
| 331 (delete-region (point) (progn (skip-chars-forward " \t") (point))) | |
| 332 (or (eolp) | |
| 333 (indent-to column 0)) | |
| 334 (forward-line 1)) | |
| 335 (move-marker end nil)))) | |
| 336 | |
| 814 | 337 (defvar indent-balanced-expression-function nil |
| 338 "Short cut function to indent balanced expression. | |
| 339 A value of nil means really run `indent-according-to-mode' on each line of | |
| 340 balanced expression as computed with `forward-sexp'.") | |
| 341 | |
| 342 (defun indent-balanced-expression () | |
| 343 "Indent each nonblank line in the balanced expression at point. | |
| 344 Use `indent-balanced-expression-function' if that's non-nil, or find | |
| 345 expression with `forward-sexp' and use `indent-region' on result." | |
| 346 (interactive "") | |
| 347 (let ((fun (or indent-balanced-expression-function | |
| 348 (cond ((memq major-mode '(c-mode c++-mode java-mode objc-mode | |
| 349 idl-mode pike-mode | |
| 350 c++-c-mode elec-c-mode)) | |
| 351 'c-indent-exp) | |
| 352 ((memq major-mode | |
| 353 '(lisp-mode | |
| 354 emacs-lisp-mode lisp-interaction-mode | |
| 355 scheme-mode inferior-scheme-mode | |
| 356 scheme-interaction-mode)) | |
| 357 'indent-sexp))))) | |
| 358 (if fun (funcall fun) | |
| 359 (let ((end (save-excursion (forward-sexp) (point)))) | |
| 360 (indent-region (point) end nil))))) | |
| 361 | |
| 362 (defun indent-region-or-balanced-expression () | |
| 363 "Indent region if active, or balanced expression at point. | |
| 364 See `indent-region' and `indent-balanced-expression'." | |
| 365 (interactive "") | |
| 366 (if (region-active-p) | |
| 367 (indent-region (region-beginning) (region-end) nil) | |
| 368 (indent-balanced-expression))) | |
| 369 | |
| 428 | 370 (defun indent-relative-maybe () |
| 371 "Indent a new line like previous nonblank line." | |
| 372 (interactive) | |
| 373 (indent-relative t)) | |
| 374 | |
| 375 (defun indent-relative (&optional unindented-ok) | |
| 376 "Space out to under next indent point in previous nonblank line. | |
| 377 An indent point is a non-whitespace character following whitespace. | |
| 378 If the previous nonblank line has no indent points beyond the | |
| 379 column point starts at, `tab-to-tab-stop' is done instead." | |
| 380 (interactive "P") | |
| 381 (if abbrev-mode (expand-abbrev)) | |
| 382 (let ((start-column (current-column)) | |
| 383 indent) | |
| 384 (save-excursion | |
| 385 (beginning-of-line) | |
| 386 (if (re-search-backward "^[^\n]" nil t) | |
| 387 (let ((end (save-excursion (forward-line 1) (point)))) | |
| 388 (move-to-column start-column) | |
| 389 ;; Is start-column inside a tab on this line? | |
| 390 (if (> (current-column) start-column) | |
| 391 (backward-char 1)) | |
| 392 (or (looking-at "[ \t]") | |
| 393 unindented-ok | |
| 394 (skip-chars-forward "^ \t" end)) | |
| 395 (skip-chars-forward " \t" end) | |
| 396 (or (= (point) end) (setq indent (current-column)))))) | |
| 397 (if indent | |
| 398 (let ((opoint (point-marker))) | |
| 399 (delete-region (point) (progn (skip-chars-backward " \t") (point))) | |
| 400 (indent-to indent 0) | |
| 401 (if (> opoint (point)) | |
| 402 (goto-char opoint)) | |
| 403 (move-marker opoint nil)) | |
| 404 (tab-to-tab-stop)))) | |
| 405 | |
| 406 (defvar tab-stop-list | |
| 407 '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120) | |
| 408 "*List of tab stop positions used by `tab-to-tab-stops'. | |
| 409 This should be a list of integers, ordered from smallest to largest.") | |
| 410 | |
| 411 (defvar edit-tab-stops-map nil "Keymap used in `edit-tab-stops'.") | |
| 412 (if edit-tab-stops-map | |
| 413 nil | |
| 414 (setq edit-tab-stops-map (make-sparse-keymap)) | |
| 415 (define-key edit-tab-stops-map "\C-x\C-s" 'edit-tab-stops-note-changes) | |
| 416 (define-key edit-tab-stops-map "\C-c\C-c" 'edit-tab-stops-note-changes)) | |
| 417 | |
| 418 (defvar edit-tab-stops-buffer nil | |
| 419 "Buffer whose tab stops are being edited--in case | |
| 420 the variable `tab-stop-list' is local in that buffer.") | |
| 421 | |
| 422 (defun edit-tab-stops () | |
| 423 "Edit the tab stops used by `tab-to-tab-stop'. | |
| 424 Creates a buffer *Tab Stops* containing text describing the tab stops. | |
| 425 A colon indicates a column where there is a tab stop. | |
| 426 You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops-note-changes] to make changes take effect." | |
| 427 (interactive) | |
| 428 (setq edit-tab-stops-buffer (current-buffer)) | |
| 429 (switch-to-buffer (get-buffer-create "*Tab Stops*")) | |
| 430 ;; #### I18N3 should mark buffer as output-translating | |
| 431 (use-local-map edit-tab-stops-map) | |
| 432 (make-local-variable 'indent-tabs-mode) | |
| 433 (setq indent-tabs-mode nil) | |
| 434 (overwrite-mode 1) | |
| 435 (setq truncate-lines t) | |
| 436 (erase-buffer) | |
| 437 (let ((tabs tab-stop-list)) | |
| 438 (while tabs | |
| 439 (indent-to (car tabs) 0) | |
| 440 (insert ?:) | |
| 441 (setq tabs (cdr tabs)))) | |
| 442 (let ((count 0)) | |
| 443 (insert ?\n) | |
| 444 (while (< count 8) | |
| 445 (insert (+ count ?0)) | |
| 446 (insert " ") | |
| 447 (setq count (1+ count))) | |
| 448 (insert ?\n) | |
| 449 (while (> count 0) | |
| 450 (insert "0123456789") | |
| 451 (setq count (1- count)))) | |
| 452 ;; XEmacs | |
| 453 (insert (substitute-command-keys "\nTo install changes, type \\<edit-tab-stops-map>\\[edit-tab-stops-note-changes]")) | |
| 454 (goto-char (point-min))) | |
| 455 | |
| 456 (defun edit-tab-stops-note-changes () | |
| 457 "Put edited tab stops into effect." | |
| 458 (interactive) | |
| 459 (let (tabs) | |
| 460 (save-excursion | |
| 461 (goto-char 1) | |
| 462 (end-of-line) | |
| 463 (while (search-backward ":" nil t) | |
| 464 (setq tabs (cons (current-column) tabs)))) | |
| 465 (bury-buffer (prog1 (current-buffer) | |
| 466 (switch-to-buffer edit-tab-stops-buffer))) | |
| 467 (setq tab-stop-list tabs)) | |
| 468 (message "Tab stops installed")) | |
| 469 | |
| 470 (defun tab-to-tab-stop () | |
| 471 "Insert spaces or tabs to next defined tab-stop column. | |
| 472 The variable `tab-stop-list' is a list of columns at which there are tab stops. | |
| 473 Use \\[edit-tab-stops] to edit them interactively." | |
| 474 (interactive) | |
| 475 (and abbrev-mode (eq (char-syntax (char-before (point))) ?w) | |
| 476 (expand-abbrev)) | |
| 477 (let ((tabs tab-stop-list)) | |
| 478 (while (and tabs (>= (current-column) (car tabs))) | |
| 479 (setq tabs (cdr tabs))) | |
| 480 (if tabs | |
| 481 (let ((opoint (point))) | |
| 482 (skip-chars-backward " \t") | |
| 483 (delete-region (point) opoint) | |
| 484 (indent-to (car tabs))) | |
| 485 (insert ?\ )))) | |
| 486 | |
| 487 (defun move-to-tab-stop () | |
| 488 "Move point to next defined tab-stop column. | |
| 489 The variable `tab-stop-list' is a list of columns at which there are tab stops. | |
| 490 Use \\[edit-tab-stops] to edit them interactively." | |
| 491 (interactive) | |
| 492 (let ((tabs tab-stop-list)) | |
| 493 (while (and tabs (>= (current-column) (car tabs))) | |
| 494 (setq tabs (cdr tabs))) | |
| 495 (if tabs | |
| 496 (let ((before (point))) | |
| 497 (move-to-column (car tabs) t) | |
| 498 (save-excursion | |
| 499 (goto-char before) | |
| 500 ;; If we just added a tab, or moved over one, | |
| 501 ;; delete any superfluous spaces before the old point. | |
| 502 (if (and (eq (char-before (point)) ?\ ) | |
| 503 (eq (char-after (point)) ?\t)) | |
| 504 (let ((tabend (* (/ (current-column) tab-width) tab-width))) | |
| 505 (while (and (> (current-column) tabend) | |
| 506 (eq (char-before (point)) ?\ )) | |
| 446 | 507 (backward-char 1)) |
| 428 | 508 (delete-region (point) before)))))))) |
| 509 | |
| 510 ;(define-key global-map "\t" 'indent-for-tab-command) | |
| 511 ;(define-key esc-map "\034" 'indent-region) | |
| 512 ;(define-key ctl-x-map "\t" 'indent-rigidly) | |
| 513 ;(define-key esc-map "i" 'tab-to-tab-stop) | |
| 514 | |
| 515 ;;; indent.el ends here |