Mercurial > hg > xemacs-beta
annotate src/indent.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| parents | c096d8051f89 |
| children | 8d29f1c4bb98 |
| rev | line source |
|---|---|
| 428 | 1 /* Indentation functions. |
| 2 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 3 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 | |
| 826 | 4 Free Software Foundation, Inc. |
| 3025 | 5 Copyright (C) 2002, 2005 Ben Wing. |
| 428 | 6 |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* Synched up with: 19.30. Diverges significantly from FSF. */ | |
| 27 | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 32 #include "buffer.h" | |
| 33 #include "device.h" | |
| 34 #include "extents.h" | |
| 35 #include "faces.h" | |
| 36 #include "frame.h" | |
| 37 #include "glyphs.h" | |
| 38 #include "insdel.h" | |
| 39 #ifdef REGION_CACHE_NEEDS_WORK | |
| 40 #include "region-cache.h" | |
| 41 #endif | |
| 42 #include "window.h" | |
| 43 | |
| 44 /* Indentation can insert tabs if this is non-zero; | |
| 45 otherwise always uses spaces */ | |
| 46 int indent_tabs_mode; | |
| 47 | |
| 48 /* Avoid recalculation by remembering things in these variables. */ | |
| 49 | |
| 50 /* Last value returned by current_column. | |
| 51 | |
| 52 Some things set last_known_column_point to -1 | |
| 53 to mark the memoized value as invalid */ | |
| 54 static int last_known_column; | |
| 55 | |
| 56 /* Last buffer searched by current_column */ | |
| 57 static struct buffer *last_known_column_buffer; | |
| 58 | |
| 59 /* Value of point when current_column was called */ | |
| 665 | 60 static Charbpos last_known_column_point; |
| 428 | 61 |
| 62 /* Value of MODIFF when current_column was called */ | |
| 63 static int last_known_column_modified; | |
| 64 | |
| 665 | 65 static Charbpos |
| 66 last_visible_position (Charbpos pos, struct buffer *buf) | |
| 428 | 67 { |
| 68 Lisp_Object buffer; | |
| 69 Lisp_Object value; | |
| 70 | |
| 793 | 71 buffer = wrap_buffer (buf); |
| 2506 | 72 value = Fprevious_single_char_property_change (make_int (pos), Qinvisible, |
| 73 buffer, Qnil); | |
| 428 | 74 if (NILP (value)) |
| 75 return 0; /* no visible position found */ | |
| 76 else | |
| 77 /* #### bug bug bug!!! This will return the position of the beginning | |
| 78 of an invisible extent; this extent is very likely to be start-closed, | |
| 79 and thus the spaces inserted in `indent-to' will go inside the | |
| 80 invisible extent. | |
| 81 | |
| 82 Not sure what the correct solution is here. Rethink indent-to? */ | |
| 83 return XINT (value); | |
| 84 } | |
| 85 | |
| 86 #ifdef REGION_CACHE_NEEDS_WORK | |
| 87 | |
| 88 /* Allocate or free the width run cache, as requested by the current | |
| 89 state of current_buffer's cache_long_line_scans variable. */ | |
| 90 static void | |
| 91 width_run_cache_on_off (struct buffer *buf) | |
| 92 { | |
| 93 if (NILP (buf->cache_long_line_scans)) | |
| 94 { | |
| 95 /* It should be off. */ | |
| 96 if (buf->width_run_cache) | |
| 97 { | |
| 98 free_region_cache (buf->width_run_cache); | |
| 99 buf->width_run_cache = 0; | |
| 100 buf->width_table = Qnil; | |
| 101 } | |
| 102 } | |
| 103 else | |
| 104 { | |
| 105 /* It should be on. */ | |
| 106 if (buf->width_run_cache == 0) | |
| 107 { | |
| 108 buf->width_run_cache = new_region_cache (); | |
| 109 recompute_width_table (buf, buffer_display_table ()); | |
| 110 } | |
| 111 } | |
| 112 } | |
| 113 | |
| 114 #endif /* REGION_CACHE_NEEDS_WORK */ | |
| 115 | |
| 116 | |
| 117 /* Cancel any recorded value of the horizontal position. */ | |
| 118 | |
| 119 void | |
| 120 invalidate_current_column (void) | |
| 121 { | |
| 122 last_known_column_point = -1; | |
| 123 } | |
| 124 | |
| 125 int | |
| 665 | 126 column_at_point (struct buffer *buf, Charbpos init_pos, int cur_col) |
| 428 | 127 { |
| 128 int col; | |
| 129 int tab_seen; | |
| 130 int tab_width = XINT (buf->tab_width); | |
| 131 int post_tab; | |
| 665 | 132 Charbpos pos = init_pos; |
| 867 | 133 Ichar c; |
| 428 | 134 |
| 135 if (tab_width <= 0 || tab_width > 1000) tab_width = 8; | |
| 136 col = tab_seen = post_tab = 0; | |
| 137 | |
| 138 while (1) | |
| 139 { | |
| 140 if (pos <= BUF_BEGV (buf)) | |
| 141 break; | |
| 142 | |
| 143 pos--; | |
| 144 c = BUF_FETCH_CHAR (buf, pos); | |
| 145 if (c == '\t') | |
| 146 { | |
| 147 if (tab_seen) | |
| 148 col = ((col + tab_width) / tab_width) * tab_width; | |
| 149 | |
| 150 post_tab += col; | |
| 151 col = 0; | |
| 152 tab_seen = 1; | |
| 153 } | |
| 154 else if (c == '\n' || | |
| 155 (EQ (buf->selective_display, Qt) && c == '\r')) | |
| 156 break; | |
| 157 else | |
| 158 { | |
| 159 /* #### This needs updating to handle the new redisplay. */ | |
| 160 /* #### FSFmacs looks at ctl_arrow, display tables. | |
| 161 We need to do similar. */ | |
| 162 #if 0 | |
| 665 | 163 displayed_glyphs = glyphs_from_charbpos (sel_frame, buf, |
| 428 | 164 XWINDOW (selected_window), |
| 165 pos, dp, 0, col, 0, 0, 0); | |
| 166 col += (displayed_glyphs->columns | |
| 167 - (displayed_glyphs->begin_columns | |
| 168 + displayed_glyphs->end_columns)); | |
| 169 #else /* XEmacs */ | |
| 170 #ifdef MULE | |
| 867 | 171 col += XCHARSET_COLUMNS (ichar_charset (c)); |
| 428 | 172 #else |
| 173 col ++; | |
| 174 #endif /* MULE */ | |
| 175 #endif /* XEmacs */ | |
| 176 } | |
| 177 } | |
| 178 | |
| 179 if (tab_seen) | |
| 180 { | |
| 181 col = ((col + tab_width) / tab_width) * tab_width; | |
| 182 col += post_tab; | |
| 183 } | |
| 184 | |
| 185 if (cur_col) | |
| 186 { | |
| 187 last_known_column_buffer = buf; | |
| 188 last_known_column = col; | |
| 189 last_known_column_point = init_pos; | |
| 190 last_known_column_modified = BUF_MODIFF (buf); | |
| 191 } | |
| 192 | |
| 193 return col; | |
| 194 } | |
| 195 | |
| 196 int | |
| 793 | 197 string_column_at_point (Lisp_Object s, Charbpos init_pos, int tab_width) |
| 428 | 198 { |
| 199 int col; | |
| 200 int tab_seen; | |
| 201 int post_tab; | |
| 665 | 202 Charbpos pos = init_pos; |
| 867 | 203 Ichar c; |
| 428 | 204 |
| 205 if (tab_width <= 0 || tab_width > 1000) tab_width = 8; | |
| 206 col = tab_seen = post_tab = 0; | |
| 207 | |
| 208 while (1) | |
| 209 { | |
| 210 if (pos <= 0) | |
| 211 break; | |
| 212 | |
| 213 pos--; | |
| 867 | 214 c = string_ichar (s, pos); |
| 428 | 215 if (c == '\t') |
| 216 { | |
| 217 if (tab_seen) | |
| 218 col = ((col + tab_width) / tab_width) * tab_width; | |
| 219 | |
| 220 post_tab += col; | |
| 221 col = 0; | |
| 222 tab_seen = 1; | |
| 223 } | |
| 224 else if (c == '\n') | |
| 225 break; | |
| 226 else | |
| 227 #ifdef MULE | |
| 867 | 228 col += XCHARSET_COLUMNS (ichar_charset (c)); |
| 428 | 229 #else |
| 230 col ++; | |
| 231 #endif /* MULE */ | |
| 232 } | |
| 233 | |
| 234 if (tab_seen) | |
| 235 { | |
| 236 col = ((col + tab_width) / tab_width) * tab_width; | |
| 237 col += post_tab; | |
| 238 } | |
| 239 | |
| 240 return col; | |
| 241 } | |
| 242 | |
| 243 int | |
| 244 current_column (struct buffer *buf) | |
| 245 { | |
| 246 if (buf == last_known_column_buffer | |
| 247 && BUF_PT (buf) == last_known_column_point | |
| 248 && BUF_MODIFF (buf) == last_known_column_modified) | |
| 249 return last_known_column; | |
| 250 | |
| 251 return column_at_point (buf, BUF_PT (buf), 1); | |
| 252 } | |
| 253 | |
| 254 DEFUN ("current-column", Fcurrent_column, 0, 1, 0, /* | |
| 255 Return the horizontal position of point. Beginning of line is column 0. | |
| 256 This is calculated by adding together the widths of all the displayed | |
| 257 representations of the character between the start of the previous line | |
| 258 and point. (e.g. control characters will have a width of 2 or 4, tabs | |
| 259 will have a variable width.) | |
| 260 Ignores finite width of frame, which means that this function may return | |
| 261 values greater than (frame-width). | |
| 262 Whether the line is visible (if `selective-display' is t) has no effect; | |
| 263 however, ^M is treated as end of line when `selective-display' is t. | |
| 264 If BUFFER is nil, the current buffer is assumed. | |
| 265 */ | |
| 266 (buffer)) | |
| 267 { | |
| 268 return make_int (current_column (decode_buffer (buffer, 0))); | |
| 269 } | |
| 270 | |
| 271 | |
| 272 DEFUN ("indent-to", Findent_to, 1, 3, "NIndent to column: ", /* | |
| 273 Indent from point with tabs and spaces until COLUMN is reached. | |
| 444 | 274 Optional second argument MINIMUM says always do at least MINIMUM spaces |
| 275 even if that goes past COLUMN; by default, MINIMUM is zero. | |
| 428 | 276 If BUFFER is nil, the current buffer is assumed. |
| 277 */ | |
| 444 | 278 (column, minimum, buffer)) |
| 428 | 279 { |
| 280 /* This function can GC */ | |
| 281 int mincol; | |
| 282 int fromcol; | |
| 283 struct buffer *buf = decode_buffer (buffer, 0); | |
| 284 int tab_width = XINT (buf->tab_width); | |
| 665 | 285 Charbpos opoint = 0; |
| 428 | 286 |
| 444 | 287 CHECK_INT (column); |
| 428 | 288 if (NILP (minimum)) |
| 289 minimum = Qzero; | |
| 290 else | |
| 291 CHECK_INT (minimum); | |
| 292 | |
| 793 | 293 buffer = wrap_buffer (buf); |
| 428 | 294 |
| 295 fromcol = current_column (buf); | |
| 296 mincol = fromcol + XINT (minimum); | |
| 444 | 297 if (mincol < XINT (column)) mincol = XINT (column); |
| 428 | 298 |
| 299 if (fromcol == mincol) | |
| 300 return make_int (mincol); | |
| 301 | |
| 302 if (tab_width <= 0 || tab_width > 1000) tab_width = 8; | |
| 303 | |
| 304 if (!NILP (Fextent_at (make_int (BUF_PT (buf)), buffer, Qinvisible, | |
| 305 Qnil, Qnil))) | |
| 306 { | |
| 665 | 307 Charbpos last_visible = last_visible_position (BUF_PT (buf), buf); |
| 428 | 308 |
| 309 opoint = BUF_PT (buf); | |
| 310 if (last_visible >= BUF_BEGV (buf)) | |
| 311 BUF_SET_PT (buf, last_visible); | |
| 312 else | |
| 563 | 313 invalid_operation ("Visible portion of buffer not modifiable", Qunbound); |
| 428 | 314 } |
| 315 | |
| 316 if (indent_tabs_mode) | |
| 317 { | |
| 318 int n = mincol / tab_width - fromcol / tab_width; | |
| 319 if (n != 0) | |
| 320 { | |
| 321 Finsert_char (make_char ('\t'), make_int (n), Qnil, buffer); | |
| 322 | |
| 323 fromcol = (mincol / tab_width) * tab_width; | |
| 324 } | |
| 325 } | |
| 326 | |
| 327 Finsert_char (make_char (' '), make_int (mincol - fromcol), Qnil, buffer); | |
| 328 | |
| 329 last_known_column_buffer = buf; | |
| 330 last_known_column = mincol; | |
| 331 last_known_column_point = BUF_PT (buf); | |
| 332 last_known_column_modified = BUF_MODIFF (buf); | |
| 333 | |
| 334 /* Not in FSF: */ | |
| 335 if (opoint > 0) | |
| 336 BUF_SET_PT (buf, opoint); | |
| 337 | |
| 338 return make_int (mincol); | |
| 339 } | |
| 340 | |
| 341 int | |
| 826 | 342 byte_spaces_at_point (struct buffer *b, Bytebpos byte_pos) |
| 428 | 343 { |
| 826 | 344 Bytebpos byte_end = BYTE_BUF_ZV (b); |
| 428 | 345 int col = 0; |
| 867 | 346 Ichar c; |
| 428 | 347 int tab_width = XINT (b->tab_width); |
| 348 | |
| 349 if (tab_width <= 0 || tab_width > 1000) | |
| 350 tab_width = 8; | |
| 351 | |
| 826 | 352 while (byte_pos < byte_end && |
| 353 (c = BYTE_BUF_FETCH_CHAR (b, byte_pos), | |
| 428 | 354 (c == '\t' |
| 355 ? (col += tab_width - col % tab_width) | |
| 356 : (c == ' ' ? ++col : 0)))) | |
| 826 | 357 INC_BYTEBPOS (b, byte_pos); |
| 428 | 358 |
| 359 return col; | |
| 360 } | |
| 361 | |
| 362 | |
| 363 DEFUN ("current-indentation", Fcurrent_indentation, 0, 1, 0, /* | |
| 364 Return the indentation of the current line. | |
| 365 This is the horizontal position of the character | |
| 366 following any initial whitespace. | |
| 367 */ | |
| 368 (buffer)) | |
| 369 { | |
| 370 struct buffer *buf = decode_buffer (buffer, 0); | |
| 665 | 371 Charbpos pos = find_next_newline (buf, BUF_PT (buf), -1); |
| 428 | 372 |
| 793 | 373 buffer = wrap_buffer (buf); |
| 428 | 374 |
| 375 if (!NILP (Fextent_at (make_int (pos), buffer, Qinvisible, Qnil, Qnil))) | |
| 376 return Qzero; | |
| 377 | |
| 826 | 378 return make_int (byte_spaces_at_point (buf, charbpos_to_bytebpos (buf, pos))); |
| 428 | 379 } |
| 380 | |
| 381 | |
| 382 DEFUN ("move-to-column", Fmove_to_column, 1, 3, 0, /* | |
| 383 Move point to column COLUMN in the current line. | |
| 384 The column of a character is calculated by adding together the widths | |
| 385 as displayed of the previous characters in the line. | |
| 386 This function ignores line-continuation; | |
| 387 there is no upper limit on the column number a character can have | |
| 388 and horizontal scrolling has no effect. | |
| 389 | |
| 390 If specified column is within a character, point goes after that character. | |
| 391 If it's past end of line, point goes to end of line. | |
| 392 | |
| 3025 | 393 A value of `coerce' for the second (optional) argument FORCE means if |
| 428 | 394 COLUMN is in the middle of a tab character, change it to spaces. |
| 395 Any other non-nil value means the same, plus if the line is too short to | |
| 396 reach column COLUMN, then add spaces/tabs to get there. | |
| 397 | |
| 398 Returns the actual column that it moved to. | |
| 399 */ | |
| 400 (column, force, buffer)) | |
| 401 { | |
| 402 /* This function can GC */ | |
| 665 | 403 Charbpos pos; |
| 428 | 404 struct buffer *buf = decode_buffer (buffer, 0); |
| 405 int col = current_column (buf); | |
| 406 int goal; | |
| 665 | 407 Charbpos end; |
| 428 | 408 int tab_width = XINT (buf->tab_width); |
| 409 | |
| 410 int prev_col = 0; | |
| 867 | 411 Ichar c = 0; |
| 428 | 412 |
| 793 | 413 buffer = wrap_buffer (buf); |
| 428 | 414 if (tab_width <= 0 || tab_width > 1000) tab_width = 8; |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5047
diff
changeset
|
415 |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5047
diff
changeset
|
416 check_integer_range (column, Qzero, make_integer (EMACS_INT_MAX)); |
| 428 | 417 goal = XINT (column); |
| 418 | |
| 419 retry: | |
| 420 pos = BUF_PT (buf); | |
| 421 end = BUF_ZV (buf); | |
| 422 | |
| 423 /* If we're starting past the desired column, | |
| 424 back up to beginning of line and scan from there. */ | |
| 425 if (col > goal) | |
| 426 { | |
| 427 pos = find_next_newline (buf, pos, -1); | |
| 428 col = 0; | |
| 429 } | |
| 430 | |
| 431 while (col < goal && pos < end) | |
| 432 { | |
| 433 c = BUF_FETCH_CHAR (buf, pos); | |
| 434 if (c == '\n') | |
| 435 break; | |
| 436 if (c == '\r' && EQ (buf->selective_display, Qt)) | |
| 437 break; | |
| 438 if (c == '\t') | |
| 439 { | |
| 440 prev_col = col; | |
| 441 col += tab_width; | |
| 442 col = col / tab_width * tab_width; | |
| 443 } | |
| 444 else | |
| 445 { | |
| 446 /* #### oh for the days of the complete new redisplay */ | |
| 447 /* #### FSFmacs looks at ctl_arrow, display tables. | |
| 448 We need to do similar. */ | |
| 449 #if 0 | |
| 665 | 450 displayed_glyphs = glyphs_from_charbpos (selected_frame (), |
| 428 | 451 buf, |
| 452 XWINDOW (Fselected_window (Qnil)), | |
| 453 pos, dp, 0, col, 0, 0, 0); | |
| 454 col += (displayed_glyphs->columns | |
| 455 - (displayed_glyphs->begin_columns | |
| 456 + displayed_glyphs->end_columns)); | |
| 457 #else /* XEmacs */ | |
| 458 #ifdef MULE | |
| 867 | 459 col += XCHARSET_COLUMNS (ichar_charset (c)); |
| 428 | 460 #else |
| 461 col ++; | |
| 462 #endif /* MULE */ | |
| 463 #endif /* XEmacs */ | |
| 464 } | |
| 465 | |
| 466 pos++; | |
| 467 } | |
| 468 | |
| 469 BUF_SET_PT (buf, pos); | |
| 470 | |
| 471 /* If a tab char made us overshoot, change it to spaces | |
| 472 and scan through it again. */ | |
| 473 if (!NILP (force) && col > goal && c == '\t' && prev_col < goal) | |
| 474 { | |
| 475 buffer_delete_range (buf, BUF_PT (buf) - 1, BUF_PT (buf), 0); | |
| 476 Findent_to (make_int (col - 1), Qzero, buffer); | |
| 477 buffer_insert_emacs_char (buf, ' '); | |
| 478 goto retry; | |
| 479 } | |
| 480 | |
| 481 /* If line ends prematurely, add space to the end. */ | |
| 482 if (col < goal && !NILP (force) && !EQ (force, Qcoerce)) | |
| 483 { | |
| 484 col = goal; | |
| 485 Findent_to (make_int (col), Qzero, buffer); | |
| 486 } | |
| 487 | |
| 488 last_known_column_buffer = buf; | |
| 489 last_known_column = col; | |
| 490 last_known_column_point = BUF_PT (buf); | |
| 491 last_known_column_modified = BUF_MODIFF (buf); | |
| 492 | |
| 493 return make_int (col); | |
| 494 } | |
| 495 | |
| 496 #if 0 /* #### OK boys, this function needs to be present, I think. | |
| 497 It was there before the 19.12 redisplay rewrite. */ | |
| 498 | |
| 826 | 499 DEFUN ("compute-motion", Fcompute_motion, 7, 7, 0, /* |
| 428 | 500 "Scan through the current buffer, calculating screen position. |
| 501 Scan the current buffer forward from offset FROM, | |
| 502 assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)-- | |
| 503 to position TO or position TOPOS--another cons of the form (HPOS . VPOS)-- | |
| 504 and return the ending buffer position and screen location. | |
| 505 | |
| 506 There are three additional arguments: | |
| 507 | |
| 508 WIDTH is the number of columns available to display text; | |
| 509 this affects handling of continuation lines. | |
| 510 This is usually the value returned by `window-width', less one (to allow | |
| 511 for the continuation glyph). | |
| 512 | |
| 513 OFFSETS is either nil or a cons cell (HSCROLL . TAB-OFFSET). | |
| 514 HSCROLL is the number of columns not being displayed at the left | |
| 515 margin; this is usually taken from a window's hscroll member. | |
| 516 TAB-OFFSET is the number of columns of the first tab that aren't | |
| 517 being displayed, perhaps because the line was continued within it. | |
| 518 If OFFSETS is nil, HSCROLL and TAB-OFFSET are assumed to be zero. | |
| 519 | |
| 520 WINDOW is the window to operate on. Currently this is used only to | |
| 521 find the display table. It does not matter what buffer WINDOW displays; | |
| 522 `compute-motion' always operates on the current buffer. | |
| 523 | |
| 524 The value is a list of five elements: | |
| 525 (POS HPOS VPOS PREVHPOS CONTIN) | |
| 526 POS is the buffer position where the scan stopped. | |
| 527 VPOS is the vertical position where the scan stopped. | |
| 528 HPOS is the horizontal position where the scan stopped. | |
| 529 | |
| 530 PREVHPOS is the horizontal position one character back from POS. | |
| 531 CONTIN is t if a line was continued after (or within) the previous character. | |
| 532 | |
| 533 For example, to find the buffer position of column COL of line LINE | |
| 534 of a certain window, pass the window's starting location as FROM | |
| 535 and the window's upper-left coordinates as FROMPOS. | |
| 536 Pass the buffer's (point-max) as TO, to limit the scan to the end of the | |
| 537 visible section of the buffer, and pass LINE and COL as TOPOS. | |
| 538 */ | |
| 539 (from, frompos, to, topos, width, offsets, window)) | |
| 540 { | |
| 665 | 541 Lisp_Object charbpos, hpos, vpos, prevhpos, contin; |
| 428 | 542 struct position *pos; |
| 543 int hscroll, tab_offset; | |
| 544 struct window *w = decode_window (window); | |
| 545 | |
| 546 CHECK_INT_COERCE_MARKER (from); | |
| 547 CHECK_CONS (frompos); | |
| 548 CHECK_INT (XCAR (frompos)); | |
| 549 CHECK_INT (XCDR (frompos)); | |
| 550 CHECK_INT_COERCE_MARKER (to); | |
| 551 CHECK_CONS (topos); | |
| 552 CHECK_INT (XCAR (topos)); | |
| 553 CHECK_INT (XCDR (topos)); | |
| 554 CHECK_INT (width); | |
| 555 if (!NILP (offsets)) | |
| 556 { | |
| 557 CHECK_CONS (offsets); | |
| 558 CHECK_INT (XCAR (offsets)); | |
| 559 CHECK_INT (XCDR (offsets)); | |
| 560 hscroll = XINT (XCAR (offsets)); | |
| 561 tab_offset = XINT (XCDR (offsets)); | |
| 562 } | |
| 563 else | |
| 564 hscroll = tab_offset = 0; | |
| 565 | |
| 566 pos = compute_motion (XINT (from), XINT (XCDR (frompos)), | |
| 567 XINT (XCAR (frompos)), | |
| 568 XINT (to), XINT (XCDR (topos)), | |
| 569 XINT (XCAR (topos)), | |
| 570 XINT (width), hscroll, tab_offset, w); | |
| 571 | |
| 793 | 572 charbpos = make_int (pos->charbpos); |
| 573 hpos = make_int (pos->hpos); | |
| 574 vpos = make_int (pos->vpos); | |
| 575 prevhpos = make_int (pos->prevhpos); | |
| 428 | 576 |
| 665 | 577 return list5 (charbpos, hpos, vpos, prevhpos, |
| 428 | 578 pos->contin ? Qt : Qnil); |
| 579 } | |
| 580 | |
| 581 #endif /* 0 */ | |
| 582 | |
| 583 /* Helper for vmotion_1 - compute vertical pixel motion between | |
| 584 START and END in the line start cache CACHE. This just sums | |
| 585 the line heights, including both the starting and ending lines. | |
| 586 */ | |
| 587 static int | |
| 588 vpix_motion (line_start_cache_dynarr *cache, int start, int end) | |
| 589 { | |
| 590 int i, vpix; | |
| 591 | |
| 592 assert (start <= end); | |
| 593 assert (start >= 0); | |
| 594 assert (end < Dynarr_length (cache)); | |
| 595 | |
| 596 vpix = 0; | |
| 597 for (i = start; i <= end; i++) | |
| 598 vpix += Dynarr_atp (cache, i)->height; | |
| 599 | |
| 600 return vpix; | |
| 601 } | |
| 602 | |
| 603 /***************************************************************************** | |
| 604 vmotion_1 | |
| 605 | |
| 606 Given a starting position ORIG, move point VTARGET lines in WINDOW. | |
| 607 Returns the new value for point. If the arg ret_vpos is not nil, it is | |
| 608 taken to be a pointer to an int and the number of lines actually moved is | |
| 609 returned in it. If the arg ret_vpix is not nil, it is taken to be a | |
| 610 pointer to an int and the vertical pixel height of the motion which | |
| 611 took place is returned in it. | |
| 612 ****************************************************************************/ | |
| 665 | 613 static Charbpos |
| 614 vmotion_1 (struct window *w, Charbpos orig, int vtarget, | |
| 428 | 615 int *ret_vpos, int *ret_vpix) |
| 616 { | |
| 617 struct buffer *b = XBUFFER (w->buffer); | |
| 618 int elt; | |
| 619 | |
| 620 elt = point_in_line_start_cache (w, orig, (vtarget < 0 | |
| 621 ? -vtarget | |
| 622 : vtarget)); | |
| 623 | |
| 624 /* #### This assertion must be true before the if statements are hit | |
| 625 but may possibly be wrong after the call to | |
| 626 point_in_line_start_cache if orig is outside of the visible | |
| 627 region of the buffer. Handle this. */ | |
| 628 assert (elt >= 0); | |
| 629 | |
| 630 /* Moving downward. */ | |
| 631 if (vtarget > 0) | |
| 632 { | |
| 633 int cur_line = Dynarr_length (w->line_start_cache) - 1 - elt; | |
| 665 | 634 Charbpos ret_pt; |
| 428 | 635 |
| 636 if (cur_line > vtarget) | |
| 637 cur_line = vtarget; | |
| 638 | |
| 639 /* The traditional FSF behavior is to return the end of buffer | |
| 640 position if we couldn't move far enough because we hit it. */ | |
| 641 if (cur_line < vtarget) | |
| 642 ret_pt = BUF_ZV (b); | |
| 643 else | |
| 644 ret_pt = Dynarr_atp (w->line_start_cache, cur_line + elt)->start; | |
| 645 | |
| 646 while (ret_pt > BUF_ZV (b) && cur_line > 0) | |
| 647 { | |
| 648 cur_line--; | |
| 649 ret_pt = Dynarr_atp (w->line_start_cache, cur_line + elt)->start; | |
| 650 } | |
| 651 | |
| 652 if (ret_vpos) *ret_vpos = cur_line; | |
| 653 if (ret_vpix) | |
| 654 *ret_vpix = vpix_motion (w->line_start_cache, elt, cur_line + elt); | |
| 655 return ret_pt; | |
| 656 } | |
| 657 else if (vtarget < 0) | |
| 658 { | |
| 659 if (elt < -vtarget) | |
| 660 { | |
| 661 if (ret_vpos) *ret_vpos = -elt; | |
| 662 if (ret_vpix) | |
| 663 *ret_vpix = vpix_motion (w->line_start_cache, 0, elt); | |
| 664 /* #### This should be BUF_BEGV (b), right? */ | |
| 4967 | 665 return Dynarr_begin (w->line_start_cache)->start; |
| 428 | 666 } |
| 667 else | |
| 668 { | |
| 669 if (ret_vpos) *ret_vpos = vtarget; | |
| 670 if (ret_vpix) | |
| 671 *ret_vpix = vpix_motion (w->line_start_cache, elt + vtarget, elt); | |
| 672 return Dynarr_atp (w->line_start_cache, elt + vtarget)->start; | |
| 673 } | |
| 674 } | |
| 675 else | |
| 676 { | |
| 677 /* No vertical motion requested so we just return the position | |
| 678 of the beginning of the current line. */ | |
| 679 if (ret_vpos) *ret_vpos = 0; | |
| 680 if (ret_vpix) | |
| 681 *ret_vpix = vpix_motion (w->line_start_cache, elt, elt); | |
| 682 | |
| 683 return Dynarr_atp (w->line_start_cache, elt)->start; | |
| 684 } | |
| 685 | |
| 1204 | 686 RETURN_NOT_REACHED(0); /* shut up compiler */ |
| 428 | 687 } |
| 688 | |
| 689 /***************************************************************************** | |
| 690 vmotion | |
| 691 | |
| 692 Given a starting position ORIG, move point VTARGET lines in WINDOW. | |
| 693 Returns the new value for point. If the arg ret_vpos is not nil, it is | |
| 694 taken to be a pointer to an int and the number of lines actually moved is | |
| 695 returned in it. | |
| 696 ****************************************************************************/ | |
| 665 | 697 Charbpos |
| 698 vmotion (struct window *w, Charbpos orig, int vtarget, int *ret_vpos) | |
| 428 | 699 { |
| 700 return vmotion_1 (w, orig, vtarget, ret_vpos, NULL); | |
| 701 } | |
| 702 | |
| 703 /* Helper for Fvertical_motion. | |
| 704 */ | |
| 705 static | |
| 706 Lisp_Object vertical_motion_1 (Lisp_Object lines, Lisp_Object window, | |
| 707 int pixels) | |
| 708 { | |
| 665 | 709 Charbpos charbpos; |
| 710 Charbpos orig; | |
| 428 | 711 int selected; |
| 712 int *vpos, *vpix; | |
| 713 int value=0; | |
| 714 struct window *w; | |
| 715 | |
| 716 if (NILP (window)) | |
| 717 window = Fselected_window (Qnil); | |
| 718 | |
| 719 CHECK_LIVE_WINDOW (window); | |
| 720 CHECK_INT (lines); | |
| 721 | |
| 722 selected = (EQ (window, Fselected_window (Qnil))); | |
| 723 | |
| 724 w = XWINDOW (window); | |
| 725 | |
| 726 orig = selected ? BUF_PT (XBUFFER (w->buffer)) | |
| 727 : marker_position (w->pointm[CURRENT_DISP]); | |
| 728 | |
| 729 vpos = pixels ? NULL : &value; | |
| 730 vpix = pixels ? &value : NULL; | |
| 731 | |
| 665 | 732 charbpos = vmotion_1 (w, orig, XINT (lines), vpos, vpix); |
| 428 | 733 |
| 734 /* Note that the buffer's point is set, not the window's point. */ | |
| 735 if (selected) | |
| 665 | 736 BUF_SET_PT (XBUFFER (w->buffer), charbpos); |
| 428 | 737 else |
| 738 set_marker_restricted (w->pointm[CURRENT_DISP], | |
| 665 | 739 make_int(charbpos), |
| 428 | 740 w->buffer); |
| 741 | |
| 742 return make_int (value); | |
| 743 } | |
| 744 | |
| 745 DEFUN ("vertical-motion", Fvertical_motion, 1, 3, 0, /* | |
| 746 Move to start of frame line LINES lines down. | |
| 747 If LINES is negative, this is moving up. | |
| 748 Optional second argument is WINDOW to move in, | |
| 749 the default is the selected window. | |
| 750 | |
| 751 Sets point to position found; this may be start of line | |
| 752 or just the start of a continuation line. | |
| 753 If optional third argument PIXELS is nil, returns number | |
| 754 of lines moved; may be closer to zero than LINES if beginning | |
| 755 or end of buffer was reached. If PIXELS is non-nil, the | |
| 756 vertical pixel height of the motion which took place is | |
| 757 returned instead of the actual number of lines moved. A | |
| 758 motion of zero lines returns the height of the current line. | |
| 759 | |
| 1268 | 760 NOTE NOTE NOTE: GNU Emacs/XEmacs difference. |
| 761 | |
| 762 What `vertical-motion' actually does is set WINDOW's buffer's point | |
| 763 if WINDOW is the selected window; else, it sets WINDOW's point. | |
| 764 This is unfortunately somewhat tricky to work with, and different | |
| 765 from GNU Emacs, which always uses the current buffer, not WINDOW's | |
| 766 buffer, always sets current buffer's point, and, from the | |
| 767 perspective of this function, temporarily makes WINDOW display | |
| 768 the current buffer if it wasn't already. | |
| 428 | 769 */ |
| 770 (lines, window, pixels)) | |
| 771 { | |
| 772 return vertical_motion_1 (lines, window, !NILP (pixels)); | |
| 773 } | |
| 774 | |
| 775 /* | |
| 776 * Like vmotion() but requested and returned movement is in pixels. | |
| 777 * HOW specifies the stopping condition. Positive means move at least | |
| 778 * PIXELS. Negative means at most. Zero means as close as possible. | |
| 779 */ | |
| 665 | 780 Charbpos |
| 781 vmotion_pixels (Lisp_Object window, Charbpos start, int pixels, int how, | |
| 428 | 782 int *motion) |
| 783 { | |
| 784 struct window *w; | |
| 665 | 785 Charbpos eobuf, bobuf; |
| 428 | 786 int defheight; |
| 787 int needed; | |
| 788 int line, next; | |
| 789 int remain, abspix, dirn; | |
| 790 int elt, nelt; | |
| 791 int i; | |
| 792 line_start_cache_dynarr *cache; | |
| 793 int previous = -1; | |
| 794 int lines; | |
| 795 | |
| 796 if (NILP (window)) | |
| 797 window = Fselected_window (Qnil); | |
| 798 | |
| 799 CHECK_LIVE_WINDOW (window); | |
| 800 w = XWINDOW (window); | |
| 801 | |
| 802 eobuf = BUF_ZV (XBUFFER (w->buffer)); | |
| 803 bobuf = BUF_BEGV (XBUFFER (w->buffer)); | |
| 804 | |
|
5047
07dcc7000bbf
put width before height consistently, fix a real bug found in the process
Ben Wing <ben@xemacs.org>
parents:
4998
diff
changeset
|
805 default_face_width_and_height (window, NULL, &defheight); |
| 428 | 806 |
| 807 /* guess num lines needed in line start cache + a few extra */ | |
| 808 abspix = abs (pixels); | |
| 809 needed = (abspix + defheight-1)/defheight + 3; | |
| 810 | |
| 811 dirn = (pixels >= 0) ? 1 : -1; | |
| 812 | |
| 813 while (1) | |
| 814 { | |
| 815 elt = point_in_line_start_cache (w, start, needed); | |
| 816 assert (elt >= 0); /* in the cache */ | |
| 817 | |
| 818 cache = w->line_start_cache; | |
| 819 nelt = Dynarr_length (cache); | |
| 820 | |
| 821 *motion = 0; | |
| 822 | |
| 823 if (pixels == 0) | |
| 824 /* No vertical motion requested so we just return the position | |
| 825 of the beginning of the current display line. */ | |
| 826 return Dynarr_atp (cache, elt)->start; | |
| 827 | |
| 828 if ((dirn < 0 && elt == 0 && | |
| 829 Dynarr_atp (cache, elt)->start <= bobuf) || | |
| 830 (dirn > 0 && elt == nelt-1 && | |
| 831 Dynarr_atp (cache, elt)->end >= eobuf)) | |
| 832 return Dynarr_atp (cache, elt)->start; | |
| 833 | |
| 834 remain = abspix; | |
| 835 for (i = elt; (dirn > 0) ? (i < nelt) : (i > 0); i += dirn) | |
| 836 { | |
| 837 /* cache line we're considering moving over */ | |
| 838 int ii = (dirn > 0) ? i : i-1; | |
| 839 | |
| 840 if (remain < 0) | |
| 841 return Dynarr_atp (cache, i)->start; | |
| 842 | |
| 843 line = Dynarr_atp (cache, ii)->height; | |
| 844 next = remain - line; | |
| 845 | |
| 846 /* is stopping condition satisfied? */ | |
| 847 if ((how > 0 && remain <= 0) || /* at least */ | |
| 848 (how < 0 && next < 0) || /* at most */ | |
| 849 (how == 0 && remain <= abs (next))) /* closest */ | |
| 850 return Dynarr_atp (cache, i)->start; | |
| 851 | |
| 852 /* moving down and nowhere left to go? */ | |
| 853 if (dirn > 0 && Dynarr_atp (cache, ii)->end >= eobuf) | |
| 854 return Dynarr_atp (cache, ii)->start; | |
| 855 | |
| 856 /* take the step */ | |
| 857 remain = next; | |
| 858 *motion += dirn * line; | |
| 859 | |
| 860 /* moving up and nowhere left to go? */ | |
| 861 if (dirn < 0 && Dynarr_atp (cache, ii)->start <= bobuf) | |
| 862 return Dynarr_atp (cache, ii)->start; | |
| 863 } | |
| 864 | |
| 865 /* get here => need more cache lines. try again. */ | |
| 866 assert (abs (*motion) > previous); /* progress? */ | |
| 867 previous = abs (*motion); | |
| 868 | |
| 869 lines = (pixels < 0) ? elt : (nelt - elt); | |
| 870 needed += (remain*lines + abspix-1)/abspix + 3; | |
| 871 } | |
| 872 | |
| 1204 | 873 RETURN_NOT_REACHED(0); /* shut up compiler */ |
| 428 | 874 } |
| 875 | |
| 876 DEFUN ("vertical-motion-pixels", Fvertical_motion_pixels, 1, 3, 0, /* | |
| 877 Move to start of frame line PIXELS vertical pixels down. | |
| 878 If PIXELS is negative, this is moving up. | |
| 879 The actual vertical motion in pixels is returned. | |
| 880 | |
| 881 Optional second argument is WINDOW to move in, | |
| 882 the default is the selected window. | |
| 883 | |
| 884 Optional third argument HOW specifies when to stop. A value | |
| 885 less than zero indicates that the motion should be no more | |
| 886 than PIXELS. A value greater than zero indicates that the | |
| 887 motion should be at least PIXELS. Any other value indicates | |
| 888 that the motion should be as close as possible to PIXELS. | |
| 889 */ | |
| 890 (pixels, window, how)) | |
| 891 { | |
| 665 | 892 Charbpos charbpos; |
| 893 Charbpos orig; | |
| 428 | 894 int selected; |
| 895 int motion; | |
| 896 int howto; | |
| 897 struct window *w; | |
| 898 | |
| 899 if (NILP (window)) | |
| 900 window = Fselected_window (Qnil); | |
| 901 | |
| 902 CHECK_LIVE_WINDOW (window); | |
| 903 CHECK_INT (pixels); | |
| 904 | |
| 905 selected = (EQ (window, Fselected_window (Qnil))); | |
| 906 | |
| 907 w = XWINDOW (window); | |
| 908 | |
| 909 orig = selected ? BUF_PT (XBUFFER (w->buffer)) | |
| 910 : marker_position (w->pointm[CURRENT_DISP]); | |
| 911 | |
| 912 howto = INTP (how) ? XINT (how) : 0; | |
| 913 | |
| 665 | 914 charbpos = vmotion_pixels (window, orig, XINT (pixels), howto, &motion); |
| 428 | 915 |
| 916 if (selected) | |
| 665 | 917 BUF_SET_PT (XBUFFER (w->buffer), charbpos); |
| 428 | 918 else |
| 919 set_marker_restricted (w->pointm[CURRENT_DISP], | |
| 665 | 920 make_int(charbpos), |
| 428 | 921 w->buffer); |
| 922 | |
| 923 return make_int (motion); | |
| 924 } | |
| 925 | |
| 926 | |
| 927 void | |
| 928 syms_of_indent (void) | |
| 929 { | |
| 930 DEFSUBR (Fcurrent_indentation); | |
| 931 DEFSUBR (Findent_to); | |
| 932 DEFSUBR (Fcurrent_column); | |
| 933 DEFSUBR (Fmove_to_column); | |
| 934 #if 0 /* #### */ | |
| 935 DEFSUBR (Fcompute_motion); | |
| 936 #endif | |
| 937 DEFSUBR (Fvertical_motion); | |
| 938 DEFSUBR (Fvertical_motion_pixels); | |
| 939 } | |
| 940 | |
| 941 void | |
| 942 vars_of_indent (void) | |
| 943 { | |
| 944 DEFVAR_BOOL ("indent-tabs-mode", &indent_tabs_mode /* | |
| 945 *Indentation can insert tabs if this is non-nil. | |
| 946 Setting this variable automatically makes it local to the current buffer. | |
| 947 */ ); | |
| 948 indent_tabs_mode = 1; | |
| 949 } |