mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 16:51:06 -07:00
Code Issues Projects Releases Wiki Activity

Merged in changes from CVS trunk.

Browse source 
Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-231
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-232
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-233
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-234
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-235
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-236
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-237
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-238
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-239
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-240
   Update from CVS


git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-152
This commit is contained in:
Karoly Lorentey 2004-04-23 14:44:11 +00:00
commit ced7ed5611
87 changed files with 2165 additions and 1066 deletions
Download patch file Download diff file Expand all files Collapse all files

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2004-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
* TODO: Use outline mode. Remove compile.el entry (done).
2004-04-18 Juri Linkov <juri@jurta.org>
* TUTORIAL.fr, TUTORIAL.pl, TUTORIAL.ru, TUTORIAL.sl, TUTORIAL.sv

41
etc/NEWS
View file

@ -88,6 +88,11 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4
** You can now use next-error (C-x `) and previous-error to advance to
the next/previous matching line found by M-x occur.
** Telnet will now prompt you for a port number with C-u M-x telnet.
+++
** New command line option -Q.
@ -374,6 +379,11 @@ If you prefer the old behavior, you can set the new user option
Info files on your system for a string, and builds a menu of the
possible matches.
*** Images in Info pages are supported.
Info pages show embedded images, in Emacs frames with image support.
Info documentation that includes images, processed with makeinfo
version 4.7 or newer, compiles to Info pages with embedded images.
+++
*** The default value for `Info-scroll-prefer-subnodes' is now nil.
@ -1950,9 +1960,34 @@ configuration files.
* Lisp Changes in Emacs 21.4
** New functions posn-at-point and posn-at-x-y returns
click-event-style position information for a given visible buffer
position or for a given window pixel coordinate.
** Function pos-visible-in-window-p now returns the pixel coordinates
and partial visiblity state of the corresponding row, if the PARTIALLY
arg is non-nil.
** The function `eql' is now available without requiring the CL package.
** The display space :width and :align-to text properties are now
supported on text terminals.
** Support for displaying image slices
*** New display property (slice X Y WIDTH HEIGHT) may be used with
an image property to display only a specific slice of the image.
*** Function insert-image has new optional fourth arg to
specify image slice (X Y WIDTH HEIGHT).
*** New function insert-sliced-image inserts a given image as a
specified number of evenly sized slices (rows x columns).
*** Trailing newlines no longer contribute to the height of a display
row; instead the height of the newline glyph is reduced. This allows
sliced images to use a height less than the default line height.
** Enhancements to stretch display properties
The display property stretch specification form `(space PROPS)', where
@ -2071,6 +2106,12 @@ number of corresponding line in current buffer.
variable `sentence-end-without-space' which contains such characters
that end a sentence without following spaces.
** The function `sentence-end' should be used to obtain the value of
the variable `sentence-end'. If the variable `sentence-end' is nil,
then this function returns the regexp constructed from the variables
`sentence-end-without-period', `sentence-end-double-space' and
`sentence-end-without-space'.
+++
** The flags, width, and precision options for %-specifications in function
`format' are now documented. Some flags that were accepted but not

175
etc/TODO
View file

@ -1,4 +1,4 @@
-*-text-*-
-*-outline-*-
If you are ready to start working on any of these TODO items, we
appreciate your help; please write to emacs-devel@gnu.org so we can be
@ -7,51 +7,48 @@ it best. Since Emacs is an FSF-copyrighted package, please be
prepared to sign legal papers to transfer the copyright on your work
to the FSF.
Small but important fixes needed in existing features:
* Small but important fixes needed in existing features:
* Make compile.el record the markers that point to error loci
on text properties in the error message lines.
* Fix the kill/yank treatment of invisible text. At the moment,
** Fix the kill/yank treatment of invisible text. At the moment,
invisible text is placed in the kill-ring, so that the contents of
the ring may not correspond to the text as displayed to the user. It
ought to be possible to omit text which is invisible (due to a
text-property, overlay, or selective display) from the kill-ring.
Important features:
* Important features:
* Provide user-friendly ways to list all available font families,
** Provide user-friendly ways to list all available font families,
display a font as a sample, etc. [fx is looking at multilingual
font selection for Emacs 22.]
* Program Enriched mode to read and save in RTF. [Is there actually a
** Program Enriched mode to read and save in RTF. [Is there actually a
decent single definition of RTF? Maybe see info at
http://latex2rtf.sourceforge.net/.]
* Implement something better than the current Refill mode. This
** Implement something better than the current Refill mode. This
probably needs some primitive support.
* Implement primitive and higher-level functions to allow filling
** Implement primitive and higher-level functions to allow filling
properly with variable-pitch faces.
* Implement a smoother vertical scroll facility, one that allows
** Implement a smoother vertical scroll facility, one that allows
C-v to scroll through a tall image.
* Implement other text formatting properties.
** Footnotes that can appear either in place or at the end of the page.
** text property that says "don't break line in middle of this".
** Implement other text formatting properties.
*** Footnotes that can appear either in place or at the end of the page.
*** text property that says "don't break line in middle of this".
Don't break the line between two characters that have the
same value of this property.
** Discretionary hyphens that are not visible when they are at end of line.
*** Discretionary hyphens that are not visible when they are at end of line.
* Make movemail work with IMAP.
** Make movemail work with IMAP.
* Internationalize Emacs's messages. [Note that this is of limited
** Internationalize Emacs's messages. [Note that this is of limited
use until the menus can display multilingual text. It also doesn't
address important issues like using the names of symbols essentially
as documentation, e.g. in command names and Custom. -- fx]
* Make the Lucid menu widget display multilingual text. [This
** Make the Lucid menu widget display multilingual text. [This
probably needs to be done from actual Emacs buffers, either directly
in the menu or by rendering in an unmapped window and copying the
pixels. Note that the relevant Xlib functions assume a specific
@ -60,48 +57,63 @@ Important features:
port now displays multilingual text in menus, but only insofar as
Emacs can encode it as utf-8 and gtk can display the result.]
* Remove the limitation that window and frame widths and heights can
** Remove the limitation that window and frame widths and heights can
be only full columns/lines.
Other features we would like:
* Other features we would like:
* Have a command suggestion help system that recognizes patterns
** Ability to map a key, including all modified-combinations.
E.g map mouse-4 to wheel-up as well as M-mouse-4 -> M-wheel-up
M-C-mouse-4 -> M-C-wheel-up, H-S-C-M-s-double-mouse-4 ->
H-S-C-M-s-double-wheel-up, ...
** Beefed-up syntax-tables.
*** recognize multi-character syntactic entities like `begin' and `end'.
*** nested string-delimiters (for Postscript's (foo(bar)baz) strings).
*** support for infix operators (with precedence).
*** support for the $ (paired delimiter) in parse-partial-sexp.
*** support for hook-chars whose effect on the parsing-state is specified
by elisp code. Thus a char could both close a string and open a comment
at the same time and do it in a context-sensitive way.
*** ability to add mode-specific data to the partial-parse-state.
** Have a command suggestion help system that recognizes patterns
of commands which could be replaced with a simpler common command.
It should not make more than one suggestion per 10 minutes.
* Add a way to define input methods by computing them (when first used)
** Add a way to define input methods by computing them (when first used)
from other input methods. Then redefine C-x 8 to use a
user-selected input method, with the default being the union of
latin-1-prefix and latin-1-postfix.
* Implement a clean way to use different major modes for
** Implement a clean way to use different major modes for
different parts of a buffer.
* Give start-process the ability to direct standard-error
** Give start-process the ability to direct standard-error
output to a different filter.
* Make desktop.el save the "frame configuration" of Emacs (in some
** Make desktop.el save the "frame configuration" of Emacs (in some
useful sense).
* Give desktop.el a feature to switch between different named
** Give desktop.el a feature to switch between different named
desktops.
* Replace finder.el with something that generates an Info file
** Replace finder.el with something that generates an Info file
which gives the same information through a menu structure. [Dave
Love started on this.]
* Implement a variant of uncompress.el or jka-compr.el that works with
** Implement a variant of uncompress.el or jka-compr.el that works with
GNU Privacy Guard for encryption. [Code exists but isn't assigned.
See the Gnus development sources for assigned code concerning GPG
use with mail, which is probably a good start.]
* Save undo information in files, and reload it when needed
** Save undo information in files, and reload it when needed
for undoing.
* Merge the Emacs regex.c with the Glibc regex.c.
** Merge the Emacs regex.c with the Glibc regex.c.
They split off a few years ago through negligence.
* Change the Windows NT menu code
** Change the Windows NT menu code
so that it handles the deep_p argument and avoids
regenerating the whole menu bar menu tree except
when the user tries to use the menubar.
@ -111,87 +123,87 @@ Other features we would like:
thread has processed the MENU_BAR_ACTIVATE_EVENT and regenerated
the whole menu bar. In the mean time, it should process other messages.
* Get some major packages installed: W3/url (development version needs
** Get some major packages installed: W3/url (development version needs
significant work), PSGML. Check the assignments file for other
packages which might go in and have been missed.
* Make keymaps a first-class Lisp object (this means a rewrite of
** Make keymaps a first-class Lisp object (this means a rewrite of
keymap.c). What should it do apart from being opaque ?
multiple inheritance ? faster where-is ? no more fix_submap_inheritance ?
what else ?
* Provide real menus on ttys. The MS-DOS implementation can serve as
** Provide real menus on ttys. The MS-DOS implementation can serve as
an example how to do part of this.
* Implement popular parts of the rest of the CL functions as compiler
** Implement popular parts of the rest of the CL functions as compiler
macros in cl-macs.
* Highlight rectangles (`mouse-track-rectangle-p' in XEmacs). Already in CUA,
** Highlight rectangles (`mouse-track-rectangle-p' in XEmacs). Already in CUA,
but it's a valuable feature worth making more general.
* Support simultaneous tty and X frames. [For a partial
** Support simultaneous tty and X frames. [For a partial
implementation, see tla branch
lorentey@elte.hu--2004/emacs--multi-tty--0 at
http://lorentey.web.elte.hu/arch/2004]
* Provide MIME support for Rmail using the Gnus MIME library. [Maybe
** Provide MIME support for Rmail using the Gnus MIME library. [Maybe
not now feasible, given Gnus maintenance decisions. fx looked at
this and can say where some of the problems are.]
* Eliminate the storm of warnings concerning char/unsigned char
** Eliminate the storm of warnings concerning char/unsigned char
mismatches that we get with proprietary compilers on various systems.
They make it difficult to spot the important warnings.
* Fix anything necessary to use `long long' EMACS_INTs with GCC.
** Fix anything necessary to use `long long' EMACS_INTs with GCC.
* Split out parts of lisp.h and generate Makefile dependencies
** Split out parts of lisp.h and generate Makefile dependencies
automatically.
* Update the FAQ.
** Update the FAQ.
* Allow auto-compression-mode to use zlib calls if zlib is available.
** Allow auto-compression-mode to use zlib calls if zlib is available.
[It's required for PNG, so may be linked anyhow.]
* Add a --pristine startup flag which does -q --no-site-file plus
** Add a --pristine startup flag which does -q --no-site-file plus
ignoring X resources (Doze equivalents?) and most of the
environment. What should not be ignored needs consideration.
* Investigate using the language environment (or locale?) to set up
** Investigate using the language environment (or locale?) to set up
more things, such as the default Ispell dictionary, calendar
holidays, quoting characters?,...
* Improve the GC (generational, incremental). (We may be able to use
** Improve the GC (generational, incremental). (We may be able to use
the Boehm collector.) [See the Boehm-GC branch in CVS for work on
this.]
* Check what hooks would help Emacspeak -- see the defadvising in W3.
** Check what hooks would help Emacspeak -- see the defadvising in W3.
* Add horizontal scroll bars.
** Add horizontal scroll bars.
* Provide an optional feature which computes a scroll bar slider's
** Provide an optional feature which computes a scroll bar slider's
size and its position from lines instead of characters.
* Make the Custom themes support do useful things.
** Make the Custom themes support do useful things.
* Investigate using GNU Lightning or similar system for incremental
** Investigate using GNU Lightning or similar system for incremental
compilation of selected bytecode functions to subrs. Converting CCL
programs to native code is probably the first thing to try, though.
* Add support for SVG (Scalable Vector Graphics) rendering to
** Add support for SVG (Scalable Vector Graphics) rendering to
Emacs.
* Allow unknown image types to be rendered via an external program
** Allow unknown image types to be rendered via an external program
converting them to, say, PBM (in the same way as PostScript?).
* Allow displaying an X window from an external program in a buffer,
** Allow displaying an X window from an external program in a buffer,
e.g. to render graphics from Java applets. [gerd and/or wmperry
thought this was feasible.]
* Allow images (not just text) in the margin to be mouse-sensitive.
** Allow images (not just text) in the margin to be mouse-sensitive.
(Requires recursing through display properties). Provide some way
to simulate mouse-clicks on marginal text without a mouse.
* Implement Lisp functions to determine properly whether a character
** Implement Lisp functions to determine properly whether a character
is displayable (particularly needed in XFree 4, sigh). Use it to
define useful glyphs that may be displayed as images or unicodes
(with ASCIIfied fallback via latin1-disp). Examples include
@ -199,40 +211,33 @@ Other features we would like:
tree displays generally, mode-line mail indicator. [See work done
already for Emacs 22 and consult fx.]
* Do something to make rms happy with fx's dynamic loading, and use it
** Do something to make rms happy with fx's dynamic loading, and use it
to implement things like auto-loaded buffer parsers and database
access in cases which need more than Lisp.
* Extend ps-print to deal with multiple font sizes, images, and extra
** Extend ps-print to deal with multiple font sizes, images, and extra
encodings.
* Provide portable undumping using mmap (per gerd design).
** Provide portable undumping using mmap (per gerd design).
* Replace gmalloc.c with the modified Doug Lea code from the current
GNU libc so that the special mmapping of buffers can be removed --
that apparently loses under Solaris, at least. [fx has mostly done
this.]
** Use the XIE X extension, if available, for image display.
* Use the XIE X extension, if available, for image display.
* Make monochrome images display using the foreground and background
** Make monochrome images display using the foreground and background
colors of the applicable faces.
* Add support for rendering antialiased text, probably using
** Add support for rendering antialiased text, probably using
XRender/Freetype.
* Rewrite make-docfile to be clean and maintainable.
* Port the conservative stack marking code of Emacs' garbage collector
** Port the conservative stack marking code of Emacs' garbage collector
to more systems, so that we can completely get rid of GCPROs.
* Reorder defcustom's in each package so that the more important
** Reorder defcustom's in each package so that the more important
options come first in the Customize buffers. This could be done by
either rearranging the file (since options are shown in the order
they appear in the *.el files), or by adding a few :set-after
attributes.
* Maybe document the features of libraries missing from the manual (or
** Maybe document the features of libraries missing from the manual (or
ancillary manuals, including the Lisp manual in some cases).
This is not worth doing for all of these packages and we need not
aim for completeness, but some may be worth documenting.
@ -253,21 +258,21 @@ Other features we would like:
cvs-status (should be described in PCL-CVS manual); other progmodes,
probably in separate manual.
* Convert the XPM bitmaps to PPM, replace the PBMs with them and scrap
** Convert the XPM bitmaps to PPM, replace the PBMs with them and scrap
the XPMs so that the colour versions work generally. (Requires care
with the colour used for the transparent regions.)
* Convenient access to the `values' variable. It would be nice to have an
** Convenient access to the `values' variable. It would be nice to have an
interface that would show you the printed reps of the elements of the
list in a menu, let you select one of the values, and put it into some
other variable, without changing the value of `values'.
* Fix skip-chars-{for,back}ward to allow character classes.
** Fix skip-chars-{for,back}ward to allow character classes.
* (Controlled by a flag) make open and close syntax match exactly,
** (Controlled by a flag) make open and close syntax match exactly,
i.e. `(' doesn't match `]'.
* Specify parameter ID-FORMAT in all calls to `file-attributes' and
** Specify parameter ID-FORMAT in all calls to `file-attributes' and
`directory-files-and-attributes' where attributes UID or GID are used.
Whenever possible, use value 'string.
When done, change meaning of default value from 'integer to 'string.
@ -275,4 +280,18 @@ Other features we would like:
the definition of `file-attributes' and `directory-files-and-attributes'
and from the calls.
* Internal changes
** Replace gmalloc.c with the modified Doug Lea code from the current
GNU libc so that the special mmapping of buffers can be removed --
that apparently loses under Solaris, at least. [fx has mostly done
this.]
** Rewrite make-docfile to be clean and maintainable.
** Add an inferior-comint-minor-mode to capture the common set of operations
offered by major modes that offer an associated inferior
comint-derived mode. I.e. basically make cmuscheme.el generic.
For use by sml-mode, python-mode, tex-mode, scheme-mode, ...
;;; arch-tag: b0a3e40b-726a-457d-9999-ba848321b036

24
leim/ChangeLog
View file

@ -1,3 +1,7 @@
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-04-09 Andrew Innes <andrewi@gnu.org>
* makefile.w32-in (distclean clean): Remove nmake specific
@ -31,7 +35,7 @@
2004-01-22 Ognyan Kulev <ogi@fmi.uni-sofia.bg> (tiny change)
* quail/cyrillic.el ("bulgarian-phonetic"): Docstring fixed.
Duplicated entry removed.
Duplicate entry removed.
("bulgarian-bds"): Docstring fixed.
2003-10-06 Dave Love <fx@gnu.org>
@ -52,7 +56,7 @@
2003-07-21 KAWABATA, Taichi <kawabata@m17n.org>
* quail/indian.el (quail-indian-update-translation): Adjusted the
* quail/indian.el (quail-indian-update-translation): Adjust the
behaviour according to the change of quail-translate-key.
2003-05-22 Kenichi Handa <handa@m17n.org>
@ -71,11 +75,11 @@
2003-02-27 David Kastrup <dak@gnu.org>
* quail/greek.el (greek-babel): add koronis transliteration.
* quail/greek.el (greek-babel): Add koronis transliteration.
2003-02-23 David Kastrup <dak@gnu.org>
* quail/greek.el (greek-babel): fix <' accent.
* quail/greek.el (greek-babel): Fix <' accent.
2003-02-17 Dave Love <fx@gnu.org>
@ -89,7 +93,7 @@
2003-02-11 KAWABATA, Taichi <kawabata@m17n.org>
* quail/indian.el (punjabi-itrans, gujarati-itrans, oriya-itrans)
(bengali-itrans, assamese-itrans, telugu-itrans kannada-itrans)
(bengali-itrans, assamese-itrans, telugu-itrans, kannada-itrans)
(malayalam-itrans, tamil-itrans): New ITRANS based input methods.
(punjabi-inscript, gujarati-inscript, oriya-inscript)
(bengali-inscript, assamese-inscript, telugu-inscript)
@ -104,7 +108,7 @@
2003-02-05 David Kastrup <dak@gnu.org>
* quail/greek.el: fix iota accent typos in greek-babel
* quail/greek.el: Fix iota accent typos in greek-babel
encoding.
2003-01-05 Dave Love <fx@gnu.org>
@ -234,8 +238,8 @@
2002-01-07 Jaeyoun Chung <jay@kldp.org>
* quail/hangul.el: removed key sequence mapping for O[rsfaqtTd].
Not used for Korean Hangul Type 2. (request from emacs-kr mailing
* quail/hangul.el: Remove key sequence mapping for O[rsfaqtTd].
Not used for Korean Hangul Type 2 (request from emacs-kr mailing
list).
2002-01-03 Eli Zaretskii <eliz@is.elta.co.il>
@ -282,7 +286,7 @@
2001-12-03 Jaeyoun Chung <jay@kldp.org>
* quail/hangul3.el: Added a few convenient composing sequences for
* quail/hangul3.el: Add a few convenient composing sequences for
Korean keyboard type 3 users.
2001-11-29 Dave Love <fx@gnu.org>
@ -293,7 +297,7 @@
2001-11-28 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in (INDIAN): Adjusted for the file name change;
* makefile.w32-in (INDIAN): Adjust for the file name change;
quail/devanagari.elc -> quail/indian.elc.
* makefile.nt (INDIAN): Likewise.

2
leim/makefile.w32-in
View file

@ -1,4 +1,4 @@
# Makefile for leim subdirectory in GNU Emacs on the Microsoft W32 API.
# -*- Makefile -*- for leim subdirectory in GNU Emacs on the Microsoft W32 API.
# Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
# Licensed to the Free Software Foundation.

4
lib-src/ChangeLog
View file

@ -1,3 +1,7 @@
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-04-17 Paul Eggert <eggert@gnu.org>
* rcs2log (Help): Clarify wording of the usage message.

2
lib-src/makefile.w32-in
View file

@ -1,4 +1,4 @@
# Makefile for GNU Emacs on the Microsoft W32 API.
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (c) 2000-2001 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.

314
lisp/ChangeLog
View file

@ -1,3 +1,252 @@
2004-04-23 Kenichi Handa <handa@m17n.org>
* international/mule-util.el (char-displayable-p): Simplified by
using internal-char-font.
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
* diff-mode.el (diff-next-error): New fun.
(diff-mode): Use it.
* simple.el (next-error): Change arg name.
Add support for the documented C-u C-x ` usage.
* frame.el (special-display-popup-frame, next-multiframe-window)
(previous-multiframe-window): Only consider frames on same display.
2004-04-22 Lars Hansen <larsh@math.ku.dk>
* info.el (Info-restore-desktop-buffer): Delete with-no-warnings.
* mh-e/mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings.
2004-04-22 Kim F. Storm <storm@cua.dk>
* net/telnet.el (telnet): Add optional port arg.
2004-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/compile.el (compilation-mode-font-lock-keywords):
Minor sanity check on the `hyperlink' slot.
* Makefile.in (recompile): Compile new files.
* emacs-lisp/bytecomp.el (batch-byte-recompile-directory):
Add byte-recompile-directory's optional `arg'.
* cvs-status.el (cvs-tree-use-charset): New var.
(cvs-tree-char-space, cvs-tree-char-hbar, cvs-tree-char-vbar)
(cvs-tree-char-branch, cvs-tree-char-eob, cvs-tree-char-bob)
(cvs-status-cvstrees): Use it.
* emacs-lisp/checkdoc.el (checkdoc-output-mode):
Make it a normal major mode.
(checkdoc-buffer-label): Make sure the file name is meaningful.
(checkdoc-output-to-error-buffer): Remove.
(checkdoc-error, checkdoc-start-section): Rewrite.
* info.el (info-node, info-menu-5, info-xref, info-header-node)
(Info-title-1-face, Info-title-2-face, Info-title-3-face)
(Info-title-4-face): Use new syntax.
(info-xref-visited): Inherit from info-xref.
* progmodes/python.el (python-maybe-jython): Don't assume point-min==1.
2004-04-21 Teodor Zlatanov <tzz@lifelogs.com>
* simple.el (next-error-last-buffer, next-error-function):
New variables for the next-error framework.
(next-error-buffer-p): New function.
(next-error-find-buffer): Generalize compilation-find-buffer.
(next-error, previous-error, first-error, next-error-no-select)
(previous-error-no-select): Move from compile.el.
* replace.el (occur-next-error, occur-1): Hook into the next-error
framework.
* progmodes/compile.el (compilation-start):
Set next-error-last-buffer so next-error knows where to jump.
(compilation-setup): Set the buffer-local variable
next-error-function to 'compilation-next-error-function.
(compilation-buffer-p, compilation-buffer-internal-p): Use an
alternate way to find if a buffer is a compilation buffer, for
next-error convenience.
(next-error-no-select, previous-error-no-select, next-error)
(previous-error, first-error): Move to simple.el.
(compilation-find-buffer): Move to next-error-find-buffer in simple.el.
(compilation-last-buffer): Remove.
(compilation-start, compilation-next-error, compilation-setup)
(compilation-next-error-function, compilation-find-buffer):
Remove compilation-last-buffer use.
2004-04-21 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in (WINS): Add url/ directory.
* font-lock.el (font-lock-preprocessor-face): Remove spurious quote.
(font-lock-warning-face): Fix spacing.
2004-04-21 Lars Hansen <larsh@math.ku.dk>
* desktop.el (desktop-buffer-mode-handlers): New variable.
Alist of major mode specific functions to restore a desktop buffer.
(desktop-buffer-handlers): Make variable obsolete.
(desktop-create-buffer): Use desktop-buffer-mode-handlers.
Catch errors signaled in handlers. Update buffer count.
Evaluate desktop-buffer-point.
(desktop-buffer-dired): Rename to dired-restore-desktop-buffer and
move to dired.el.
(desktop-buffer-info): Rename to Info-restore-desktop-buffer and
move to info.el.
(desktop-buffer-rmail): Rename to rmail-restore-desktop-buffer and
move to mail/rmail.el.
(desktop-buffer-mh): Rename to mh-restore-desktop-buffer and move
to mh-e/mh-e.el.
(desktop-buffer-file): Rename to desktop-restore-file-buffer.
On fail, print message (to message buffer) even if
desktop-missing-file-warning is nil.
(desktop-buffer-misc-data-function): New buffer local variable.
Function returning major mode specific data.
(desktop-buffer-misc-functions): Make variable obsolete.
(desktop-save): Use desktop-buffer-misc-data-function.
(desktop-buffer-dired-misc-data): Rename to
dired-desktop-buffer-misc-data and move to dired.el.
(desktop-buffer-info-misc-data): Rename to
Info-desktop-buffer-misc-data and move to info.el.
(desktop-read): Add message about number of buffers restored/failed.
* dired.el (dired-restore-desktop-buffer) Move from desktop.el.
Add parameters. Pause to display error only when
desktop-missing-file-warning is non-nil.
(dired-desktop-buffer-misc-data): Move from desktop.el. Add parameter.
* info.el (Info-restore-desktop-buffer): Move from desktop.el.
Add Parameters.
(Info-desktop-buffer-misc-data): Move from desktop.el. Add parameter.
* mail/rmail.el (rmail-restore-desktop-buffer): Move from desktop.el.
Add Parameters.
* mh-e/mh-e.el (mh-restore-desktop-buffer): Move from desktop.el.
Add Parameters.
2003-04-21 Paul Pogonyshev <pogonyshev@gmx.net>
* dabbrev.el (dabbrev--substitute-expansion): Fix a bug which lost
the case of letters in case-insensitive expansions on certain
abbreviations.
2004-04-21 Richard M. Stallman <rms@gnu.org>
* progmodes/cperl-mode.el (cperl-putback-char):
Delete Emacs 18 definition.
* international/mule.el (ctext-post-read-conversion):
Use assoc-string, not assoc-ignore-case.
* international/mule-cmds.el: Use assoc-string, not assoc-ignore-case.
* emacs-lisp/easymenu.el (easy-menu-add):
Do call x-popup-menu, but only if it's defined.
* emacs-lisp/disass.el (disassemble): Handle lambda-exp as arg.
* emacs-lisp/bytecomp.el (byte-compile-no-warnings):
Handle multiple args: compile like progn.
* emacs-lisp/byte-run.el (with-no-warnings): Simplify:
take all args as &rest arg.
* autoinsert.el (auto-insert-alist): Insert the user's name in
copyright notice, rather than Free Software Foundation.
2004-04-21 Kenichi Handa <handa@m17n.org>
* descr-text.el (describe-char): Make it work on *Help* buffer.
2004-04-21 Kim F. Storm <storm@cua.dk>
* image.el (insert-image): Add optional SLICE arg.
(insert-sliced-image): New defun.
2004-04-20 Lawrence Mitchell <wence@gmx.li> (tiny change)
* subr.el (read-number): Check whether `default' is nil.
2004-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/compile.el (compilation-error-properties):
Split into two.
(compilation-internal-error-properties): New one.
(compilation-compat-error-properties): Use it. Fix the non-marker case.
2004-04-20 Richard M. Stallman <rms@gnu.org>
* window.el (split-window-save-restore-data):
Don't update the data if OLD-INFO is nil.
* view.el (view-return-to-alist): Mark it permanent local.
* subr.el (event-modifiers): Fix the criterion for ASCII control chars.
* recentf.el (recentf-save-list): Catch and warn about errors.
* menu-bar.el (menu-bar-update-buffers): Call copy-sequence
so "Buffers" won't be pure.
* help-mode.el (help-mode-finish): Set help-return-alist first
thing, setting only the entry for the selected window.
* help-fns.el (describe-function-1): If many non-control non-meta
keys run the command, don't list all of them.
2004-04-20 Juanma Barranquero <lektu@terra.es>
* vc-svn.el (vc-svn-print-log, vc-svn-diff): Add optional BUFFER
arg. Copied from Andre Spiegel's patch of 2004-03-21.
* calendar/time-date.el (time-to-day-in-year): Fix docstring.
2004-04-20 Kenichi Handa <handa@m17n.org>
* international/quail.el (quail-lookup-key): New optional arg
NOT-RESET-INDICES.
(quail-get-translations): Call quail-lookup-key with
NOT-RESET-INDICES t.
(quail-completion): Likewise.
(quail-lookup-map-and-concat): Likewise.
2004-04-20 Kenichi Handa <handa@m17n.org>
* international/quail.el (quail-update-translation): Don't insert
such an unsupported multibyte char in a unibyte buffer.
2004-04-20 Nick Roberts <nick@nick.uklinux.net>
* progmodes/gdb-ui.el (gdb-frame-parameters): New constant.
(gdb-frame-breakpoints-buffer, gdb-frame-stack-buffer)
(gdb-frame-threads-buffer, gdb-frame-registers-buffer)
(gdb-frame-locals-buffer, gdb-frame-gdb-buffer)
(gdb-frame-assembler-buffer): Improve behaviour with
multiple frames.
(gdb-display-buffer): Extend search to all visible frames.
2004-04-19 Eli Zaretskii <eliz@gnu.org>
* mail/rmail.el (rmail-convert-to-babyl-format): Don't remove ^M
characters left after base64 decoding.
(rmail-decode-region): Use -dos variety of `coding', to remove any
^M characters left after qp or base64 decoding.
2004-04-19 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* x-dnd.el (x-dnd-open-local-file, x-dnd-open-file): Improve error
messages.
2004-04-19 Stephen Eglen <stephen@gnu.org>
* add-log.el (add-change-log-entry): Update doc string to mention
add-log-full-name and add-log-mailing-address.
2004-04-18 Juri Linkov <juri@jurta.org>
* info.el (Info-find-file, Info-find-node-2): Add history and toc.
@ -18,6 +267,22 @@
* international/mule-diag.el (list-input-methods):
Fix args to help-xref-button.
* help-fns.el (help-with-tutorial): Call `hack-local-variables'
to put into effect local variables from TUTORIAL files.
* textmodes/paragraphs.el (sentence-end) <function>: New fun
with default value taken from the variable `sentence-end'.
(sentence-end) <defcustom>: Set default to nil. Doc fix.
Add nil const to :type.
(sentence-end-without-period, sentence-end-double-space)
(sentence-end-without-space): Doc fix.
* textmodes/paragraphs.el (forward-sentence):
* textmodes/fill.el (canonically-space-region, fill-nobreak-p)
(fill-delete-newlines):
* progmodes/cc-cmds.el (c-beginning-of-statement):
Use function `sentence-end' instead of variable `sentence-end'.
2004-04-18 Andreas Schwab <schwab@suse.de>
* progmodes/compile.el (compilation-start): Set window start to
@ -25,7 +290,7 @@
2004-04-18 John Wiegley <johnw@newartisans.com>
* iswitchb.el (iswitchb-completions): Removed dependency on cl.
* iswitchb.el (iswitchb-completions): Remove dependency on cl.
2004-04-18 Nick Roberts <nick@nick.uklinux.net>
@ -38,7 +303,7 @@
2004-04-17 John Wiegley <johnw@newartisans.com>
* iswitchb.el (iswitchb-max-to-show): Added a new config variable
* iswitchb.el (iswitchb-max-to-show): Add a new config variable
which limits the number of names shown in the minibuffer. Off by
default.
(iswitchb-completions): Use `iswitchb-max-to-show'. This speeds
@ -124,7 +389,7 @@
2004-04-16 Masatake YAMATO <jet@gyve.org>
* simple.el (completion-setup-function): Set an initial value
to `element-common-end' before entering loop. Set a value
to `element-common-end' before entering loop. Set a value
to `element-common-end' at the end of loop.
The bug is reported by Juri Linkov <juri@jurta.org> in emacs-devel list.
(completions-common-part): Rename from completion-de-emphasis.
@ -481,7 +746,8 @@
Use Info-search-whitespace-regexp. Set Info-search-case-fold.
(Info-search-case-sensitively, Info-search-next): New fun.
(Info-up): Move point to the menu item of the current node.
(Info-history): New fun. Add *info-history* to same-window-buffer-names.
(Info-history): New fun. Add *info-history* to
same-window-buffer-names.
(Info-toc): New fun. Add *info-toc* to same-window-buffer-names.
(Info-insert-toc): New fun.
(Info-build-toc): New fun.
@ -1731,7 +1997,7 @@
(top-level): Require password.el if visible. Should be mandatory
once No Gnus has found its way into (X)Emacs.
(tramp-read-passwd): Invoke `password-read' if available,
`read-passwd' otherwise. `ange-ftp-read-passwd' isn't used as
`read-passwd' otherwise. `ange-ftp-read-passwd' isn't used as
fallback any longer.
(tramp-clear-passwd): New function.
(tramp-process-actions, tramp-process-multi-actions):
@ -3153,7 +3419,7 @@
* gdb-ui.el (gdb-prompt): Change filter for level 3 annotations,
if necessary.
(gdb-ann3): New function. Initialise M-x gdb as for M-x gdba if
(gdb-ann3): New function. Initialise M-x gdb as for M-x gdba if
annotations are detected.
(gud-gdba-marker-filter): Use global variable gud-marker-acc
instead of a local one to allow transition from
@ -3247,7 +3513,7 @@
* gdb-ui.el (gdba, gdb-assembler-mode): Call the mode "Machine" as
a mode called "Assembler" already exists.
(gdb-use-colon-colon-notation, gdb-show-changed-values): New options.
(gud-watch): Use format option. Remove font properties from string.
(gud-watch): Use format option. Remove font properties from string.
(gdb-var-create-handler, gdb-var-list-children-handler):
Don't bother about properties as there are none.
(gdb-var-create-handler, gdb-var-list-children-handler)
@ -3340,7 +3606,7 @@
(tramp-handle-file-attributes): Replace proprietary optional
parameter NONNUMERIC by the recently (Emacs 21.4) introduced ID-FORMAT.
(tramp-handle-file-attributes-with-perl): Handle parameter
NONNUMERIC if set. This wasn't done in the past.
NONNUMERIC if set. This wasn't done in the past.
(tramp-post-connection): Apply second parameter "$2" if
`tramp-remote-perl' is called.
@ -4114,7 +4380,7 @@
* progmodes/gud.el (gud-menu-map, gud-tool-bar-map):
Replace gud-display with gud-watch.
(gud-speedbar-buttons): Add stuff for watching expressions
in the speedbar when using M-x gdba. Use dolist on old part
in the speedbar when using M-x gdba. Use dolist on old part
of this function.
* gdb-ui.el (gdb-var-list, gdb-var-changed, gdb-update-flag)
@ -4349,7 +4615,7 @@
* ffap.el (ffap-shell-prompt-regexp): Add regexp to identify
common shell prompts that are not common filename or URL characters.
(ffap-file-at-point): Use the new regexp to strip the prompts from
the file names. This is an issue mostly for user prompts that
the file names. This is an issue mostly for user prompts that
don't have a trailing space and find-file-at-point is invoked from
within a shell inside emacs.
@ -4566,7 +4832,7 @@
* gdb-ui.el (gud-display1): Use gud-call to prevent extra prompt
being displayed in GUD buffer.
(gdb-idle-input-queue): Remove var. Use just one queue.
(gdb-idle-input-queue): Remove var. Use just one queue.
(gdb-enqueue-idle-input,gdb-dequeue-idle-input):
Remove functions. Use just one queue.
(gdb-prompt, gdb-subprompt, def-gdb-auto-update-trigger)
@ -4750,7 +5016,7 @@
2003-08-24 Nick Roberts <nick@nick.uklinux.net>
* progmodes/gud.el (gud-display-line): Don't set window-point if
source buffer is not visible. (Only happens with M-x gdba).
source buffer is not visible. (Only happens with M-x gdba.)
* gdb-ui.el (gdba): Remove gdb-quit (previously removed) from
documentation.
@ -5789,33 +6055,33 @@
(bibtex-autokey-get-names): Fiddle with regexps.
(bibtex-generate-autokey): Use identity.
(bibtex-parse-keys): Use simplified parsing algorithm if
bibtex-parse-keys-fast is non-nil. Simplify. Change order of
arguments. Return alist of keys.
(bibtex-parse-strings): Simplify. Return alist of strings.
bibtex-parse-keys-fast is non-nil. Simplify. Change order of
arguments. Return alist of keys.
(bibtex-parse-strings): Simplify. Return alist of strings.
(bibtex-complete-string-cleanup): Fix docstring.
(bibtex-read-key): New function.
(bibtex-mode): Fix docstring. Do not parse for keys and
strings when the mode is entered. Set fill-paragraph-function to
bibtex-fill-field. Setup font-lock-mark-block-function the way
(bibtex-mode): Fix docstring. Do not parse for keys and
strings when the mode is entered. Set fill-paragraph-function to
bibtex-fill-field. Setup font-lock-mark-block-function the way
font-lock intended.
(bibtex-entry): Use bibtex-read-key. Obey bibtex-autofill-types.
(bibtex-entry): Use bibtex-read-key. Obey bibtex-autofill-types.
(bibtex-parse-entry, bibtex-autofill-entry): New functions.
(bibtex-print-help-message, bibtex-remove-OPT-or-ALT)
(bibtex-Preamble): Avoid hard coded constants.
(bibtex-make-field): Fix docstring. Simplify.
(bibtex-make-field): Fix docstring. Simplify.
(bibtex-beginning-of-entry): Always return new position of point.
(bibtex-end-of-entry): Rearrange cond clauses.
(bibtex-count-entries, bibtex-validate, bibtex-reformat):
Update for changes of bibtex-map-entries.
(bibtex-ispell-abstract): Do not move point.
(bibtex-entry-index): Use downcase. Simplify.
(bibtex-entry-index): Use downcase. Simplify.
(bibtex-lessp): Handle catch-all.
(bibtex-find-crossref): Turn into a command.
(bibtex-find-entry): Simplify. Use bibtex-read-key. Fix regexp.
(bibtex-clean-entry): Use bibtex-read-key. Handle string and
(bibtex-find-entry): Simplify. Use bibtex-read-key. Fix regexp.
(bibtex-clean-entry): Use bibtex-read-key. Handle string and
preamble entries.
(bibtex-fill-field-bounds): New function.
(bibtex-fill-field): New command. Bound to fill-paragraph-function.
(bibtex-fill-field): New command. Bound to fill-paragraph-function.
(bibtex-fill-entry): Use bibtex-fill-field-bounds
(bibtex-String): Use bibtex-strings. Always obey
bibtex-sort-ignore-string-entries.

16
lisp/ChangeLog.10
View file

@ -8320,17 +8320,27 @@
indicating source of entry to add-to-diary-list.
(diary-button-face, diary-entry, diary-goto-entry): New, to
support click to diary file.
(fancy-diary-display): Buttonize diary entries.
(fancy-diary-display): Buttonize diary entries. Use new mode
fancy-diary-display-mode.
(list-sexp-diary-entries): Pass a marker indicating source of
entry to add-to-diary-list.
(diary-date): Return mark as well as entry.
(add-to-diary-list): Add new marker argument, appended to
diary-entries-list.
(diary-mode, fancy-diary-display-mode): New derived modes, for
diary file and fancy diary buffer respectively.
(fancy-diary-font-lock-keywords, diary-font-lock-keywords): New
variables.
(font-lock-diary-sexps, font-lock-diary-date-forms): New
functions, used in diary-font-lock-keywords.
* calendar/calendar.el (diary-face): New.
(european-calendar-display-form, describe-calendar-mode)
(mark-visible-calendar-date, calendar-mark-today): Tidy doc string.
(calendar-make-alist): New.
(calendar-mode): Set up font-lock mode.
(calendar-mode): Set up font-lock mode, using new variable
calendar-font-lock-keywords.
(generate-calendar-window): Fontify if font-lock-mode is on.
(calendar-font-lock-keywords): New variable.
2002-11-16 Ivan Zakharyaschev <imz@altlinux.org> (tiny change)

2
lisp/Makefile.in
View file

@ -282,7 +282,7 @@ compile-after-backup: backup-compiled-files compile-always
# .elc is present.
recompile: doit $(lisp)/progmodes/cc-mode.elc
$(EMACS) $(EMACSOPT) -f batch-byte-recompile-directory $(lisp)
$(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp)
# CC Mode uses a compile time macro system which causes a compile time
# dependency in cc-mode.elc on the macros in cc-langs.el and the

2
lisp/add-log.el
View file

@ -445,7 +445,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
"Find change log file, and add an entry for today and an item for this file.
Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
name and site.
name and email (stored in `add-log-full-name' and `add-log-mailing-address').
Second arg FILE-NAME is file name of the change log.
If nil, use the value of `change-log-default-name'.

2
lisp/autoinsert.el
View file

@ -136,7 +136,7 @@ If this contains a %s, that will be replaced by the matching rule."
(("\\.[1-9]\\'" . "Man page skeleton")
"Short description: "
".\\\" Copyright (C), " (substring (current-time-string) -4) " "
(getenv "ORGANIZATION") | "Free Software Foundation, Inc."
(getenv "ORGANIZATION") | (progn user-full-name)
"
.\\\" You may distribute this file under the terms of the GNU Free
.\\\" Documentation Licence.

2
lisp/calendar/time-date.el
View file

@ -149,7 +149,7 @@ DATE1 and DATE2 should be date-time strings."
;;;###autoload
(defun time-to-day-in-year (time)
"Return the day number within the year of the date month/day/year."
"Return the day number within the year corresponding to TIME."
(let* ((tim (decode-time time))
(month (nth 4 tim))
(day (nth 3 tim))

42
lisp/cvs-status.el
View file

@ -1,4 +1,4 @@
;;; cvs-status.el --- major mode for browsing `cvs status' output
;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*-
;; Copyright (C) 1999, 2000, 03, 2004 Free Software Foundation, Inc.
@ -384,23 +384,45 @@ the list is a three-string list TAG, KIND, REV."
;;;; CVSTree-style trees
;;;;
(defvar cvs-tree-use-jisx0208
(and (char-displayable-p (make-char 'japanese-jisx0208 40 44)) t)
(defvar cvs-tree-use-jisx0208 nil) ;Old compat var.
(defvar cvs-tree-use-charset
(cond
(cvs-tree-use-jisx0208 'jisx0208)
((char-displayable-p ?━) 'unicode)
((char-displayable-p (make-char 'japanese-jisx0208 40 44)) 'jisx0208))
"*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
Otherwise, default to ASCII chars like +, - and |.")
(defconst cvs-tree-char-space
(if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 33 33) " "))
(case cvs-tree-use-charset
(jisx0208 (make-char 'japanese-jisx0208 33 33))
(unicode " ")
(t " ")))
(defconst cvs-tree-char-hbar
(if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 44) "--"))
(case cvs-tree-use-charset
(jisx0208 (make-char 'japanese-jisx0208 40 44))
(unicode "━")
(t "--")))
(defconst cvs-tree-char-vbar
(if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 45) "| "))
(case cvs-tree-use-charset
(jisx0208 (make-char 'japanese-jisx0208 40 45))
(unicode "┃")
(t "| ")))
(defconst cvs-tree-char-branch
(if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 50) "+-"))
(case cvs-tree-use-charset
(jisx0208 (make-char 'japanese-jisx0208 40 50))
(unicode "┣")
(t "+-")))
(defconst cvs-tree-char-eob ;end of branch
(if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 49) "`-"))
(case cvs-tree-use-charset
(jisx0208 (make-char 'japanese-jisx0208 40 49))
(unicode "┗")
(t "`-")))
(defconst cvs-tree-char-bob ;beginning of branch
(if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 51) "+-"))
(case cvs-tree-use-charset
(jisx0208 (make-char 'japanese-jisx0208 40 51))
(unicode "┳")
(t "+-")))
(defun cvs-tag-lessp (tag1 tag2)
(eq (cvs-tag-compare tag1 tag2) 'more2))
@ -411,7 +433,7 @@ Otherwise, default to ASCII chars like +, - and |.")
"Look for a list of tags, and replace it with a tree.
Optional prefix ARG chooses between two representations."
(interactive "P")
(when (and cvs-tree-use-jisx0208
(when (and cvs-tree-use-charset
(not enable-multibyte-characters))
;; We need to convert the buffer from unibyte to multibyte
;; since we'll use multibyte chars for the tree.

29
lisp/dabbrev.el
View file

@ -888,23 +888,28 @@ to record whether we upcased the expansion, downcased it, or did neither."
;; matches the start of the expansion,
;; copy the expansion's case
;; instead of downcasing all the rest.
;; Treat a one-capital-letter abbrev as "not all upper case",
;; so as to force preservation of the expansion's pattern
;; if the expansion starts with a capital letter.
(let ((expansion-rest (substring expansion 1)))
(if (and (not (and (or (string= expansion-rest (downcase expansion-rest))
(string= expansion-rest (upcase expansion-rest)))
(or (string= abbrev (downcase abbrev))
(and (string= abbrev (upcase abbrev))
(> (length abbrev) 1)))))
(string= abbrev
(substring expansion 0 (length abbrev))))
;;
;; Treat a one-capital-letter (possibly with preceding non-letter
;; characters) abbrev as "not all upper case", so as to force
;; preservation of the expansion's pattern if the expansion starts
;; with a capital letter.
(let ((expansion-rest (substring expansion 1))
(first-letter-position (string-match "[[:alpha:]]" abbrev)))
(if (or (null first-letter-position)
(and (not (and (or (string= expansion-rest (downcase expansion-rest))
(string= expansion-rest (upcase expansion-rest)))
(or (string= abbrev (downcase abbrev))
(and (string= abbrev (upcase abbrev))
(> (- (length abbrev) first-letter-position)
1)))))
(string= abbrev
(substring expansion 0 (length abbrev)))))
(setq use-case-replace nil)))
;; If the abbrev and the expansion are both all-lower-case
;; then don't do any conversion. The conversion would be a no-op
;; for this replacement, but it would carry forward to subsequent words.
;; The goal of this is to preven that carrying forward.
;; The goal of this is to prevent that carrying forward.
(if (and (string= expansion (downcase expansion))
(string= abbrev (downcase abbrev)))
(setq use-case-replace nil))

17
lisp/descr-text.el
View file

@ -474,6 +474,7 @@ as well as widgets, buttons, overlays, and text properties."
standard-display-table))
(disp-vector (and display-table (aref display-table char)))
(multibyte-p enable-multibyte-characters)
text-prop-description
item-list max-width unicode)
(if (eq charset 'unknown)
(setq item-list
@ -582,8 +583,14 @@ as well as widgets, buttons, overlays, and text properties."
(cons (list "Unicode data" " ") unicodedata))))))
(setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
item-list)))
(when (eq (current-buffer) (get-buffer "*Help*"))
(error "Can't describe char in Help buffer"))
(setq text-prop-description
(with-temp-buffer
(let ((buf (current-buffer)))
(save-excursion
(set-buffer buffer)
(describe-text-properties pos buf)))
(buffer-string)))
(with-output-to-temp-buffer "*Help*"
(with-current-buffer standard-output
(set-buffer-multibyte multibyte-p)
@ -658,10 +665,8 @@ as well as widgets, buttons, overlays, and text properties."
(insert "\nSee the variable `reference-point-alist' for "
"the meaning of the rule.\n"))
(let ((output (current-buffer)))
(with-current-buffer buffer
(describe-text-properties pos output))
(describe-text-mode))))))
(insert text-prop-description)
(describe-text-mode)))))
(defalias 'describe-char-after 'describe-char)
(make-obsolete 'describe-char-after 'describe-char "21.5")

240
lisp/desktop.el
View file

@ -83,12 +83,6 @@
;;; Code:
;; Make the compilation more silent
(eval-when-compile
;; We use functions from these modules
;; We can't (require 'mh-e) since that wants to load something.
(mapcar 'require '(info dired reporter)))
(defvar desktop-file-version "206"
"Version number of desktop file format.
Written into the desktop file and used at desktop read to provide
@ -253,8 +247,9 @@ The variables are saved only when they really are local."
(defcustom desktop-buffer-modes-to-save
'(Info-mode rmail-mode)
"If a buffer is of one of these major modes, save the buffer state.
It is up to the functions in `desktop-buffer-handlers' to decide
whether the buffer should be recreated or not, and how."
This applies to buffers not visiting a file and not beeing a dired buffer.
Modes specified here must have a handler in `desktop-buffer-mode-handlers'
to be restored."
:type '(repeat symbol)
:group 'desktop)
@ -272,53 +267,59 @@ Possible values are:
:type '(choice (const absolute) (const tilde) (const local))
:group 'desktop)
(defcustom desktop-buffer-misc-functions
'(desktop-buffer-info-misc-data
desktop-buffer-dired-misc-data)
"*Functions used to determine auxiliary information for a buffer.
These functions are called by `desktop-save' in order, with no
arguments. If a function returns non-nil, its value is saved along
with the state of the buffer for which it was called; no further
functions will be called.
;;;###autoload
(defvar desktop-buffer-misc-data-function nil
"Function returning major mode specific data for desktop file.
This variable becomes buffer local when set.
The function specified is called by `desktop-save', with argument
DESKTOP-DIRNAME. If it returns non-nil, its value is saved along
with the state of the buffer for which it was called.
When file names are returned, they should be formatted using the call
\"(desktop-file-name FILE-NAME dirname)\".
\"(desktop-file-name FILE-NAME DESKTOP-DIRNAME)\".
Later, when `desktop-read' restores buffers, each of the functions in
`desktop-buffer-handlers' will have access to a buffer local variable,
named `desktop-buffer-misc', whose value is what the function in
`desktop-buffer-misc-functions' returned."
:type '(repeat function)
:group 'desktop)
Later, when `desktop-read' calls a function in `desktop-buffer-mode-handlers'
to restore the buffer, the auxiliary information is passed as argument.")
(make-variable-buffer-local 'desktop-buffer-misc-data-function)
(make-obsolete-variable 'desktop-buffer-misc-functions
'desktop-buffer-misc-data-function)
(defcustom desktop-buffer-handlers
'(desktop-buffer-dired
desktop-buffer-rmail
desktop-buffer-mh
desktop-buffer-info
desktop-buffer-file)
"*Functions called by `desktop-read' in order to create a buffer.
The functions are called without explicit parameters but can use the
following variables:
(defcustom desktop-buffer-mode-handlers '(
(dired-mode . dired-restore-desktop-buffer)
(rmail-mode . rmail-restore-desktop-buffer)
(mh-folder-mode . mh-restore-desktop-buffer)
(Info-mode . Info-restore-desktop-buffer))
"Alist of major mode specific functions to restore a desktop buffer.
Functions are called by `desktop-read'. List elements must have the form
\(MAJOR-MODE . FUNCTION).
Buffers with a major mode not specified here, are restored by the default
handler `desktop-restore-file-buffer'.
Handlers are called with parameters
desktop-file-version
desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc
Furthermore, they may use the following variables:
desktop-file-version
desktop-buffer-major-mode
desktop-buffer-minor-modes
desktop-buffer-point
desktop-buffer-mark
desktop-buffer-read-only
desktop-buffer-misc
desktop-buffer-locals
If one function returns non-nil, no further functions are called.
If the function returns a buffer, then the saved mode settings
If a handler returns a buffer, then the saved mode settings
and variable values for that buffer are copied into it."
:type '(repeat function)
:type 'alist
:group 'desktop)
(put 'desktop-buffer-handlers 'risky-local-variable t)
(put 'desktop-buffer-mode-handlers 'risky-local-variable t)
(make-obsolete-variable 'desktop-buffer-handlers
'desktop-buffer-mode-handlers)
(defcustom desktop-minor-mode-table
'((auto-fill-function auto-fill-mode)
@ -608,7 +609,9 @@ See also `desktop-base-file-name'."
(point)
(list (mark t) mark-active)
buffer-read-only
(run-hook-with-args-until-success 'desktop-buffer-misc-functions)
;; Auxiliary information
(when desktop-buffer-misc-data-function
(funcall desktop-buffer-misc-data-function dirname))
(let ((locals desktop-locals-to-save)
(loclist (buffer-local-variables))
(ll))
@ -703,7 +706,9 @@ It returns t if a desktop file was loaded, nil otherwise."
"~"))))
(if (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))
;; Desktop file found, process it.
(let ((desktop-first-buffer nil))
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0))
;; Evaluate desktop buffer.
(load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
;; `desktop-create-buffer' puts buffers at end of the buffer list.
@ -715,7 +720,12 @@ It returns t if a desktop file was loaded, nil otherwise."
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(run-hooks 'desktop-after-read-hook)
(message "Desktop loaded.")
(message "Desktop: %d buffer%s restored%s."
desktop-buffer-ok-count
(if (= 1 desktop-buffer-ok-count) "" "s")
(if (< 0 desktop-buffer-fail-count)
(format ", %d failed to restore" desktop-buffer-fail-count)
""))
t)
;; No desktop file found.
(desktop-clear)
@ -772,106 +782,21 @@ directory DIRNAME."
(desktop-read desktop-dirname))
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;;
(eval-when-compile ; Just to silence the byte compiler
(defvar desktop-file-version)
(defvar desktop-buffer-file-name)
(defvar desktop-buffer-name)
(defvar desktop-buffer-major-mode)
(defvar desktop-buffer-minor-modes)
(defvar desktop-buffer-point)
(defvar desktop-buffer-mark)
(defvar desktop-buffer-read-only)
(defvar desktop-buffer-misc)
(defvar desktop-buffer-locals)
)
(defun desktop-buffer-info-misc-data ()
(if (eq major-mode 'Info-mode)
(list Info-current-file
Info-current-node)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired-misc-data ()
(when (eq major-mode 'dired-mode)
(eval-when-compile (defvar dirname))
(cons
;; Value of `dired-directory'.
(if (consp dired-directory)
;; Directory name followed by list of files.
(cons (desktop-file-name (car dired-directory) dirname) (cdr dired-directory))
;; Directory name, optionally with with shell wildcard.
(desktop-file-name dired-directory dirname))
;; Subdirectories in `dired-subdir-alist'.
(cdr
(nreverse
(mapcar
(function (lambda (f) (desktop-file-name (car f) dirname)))
dired-subdir-alist))))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info () "Load an info file."
(if (eq 'Info-mode desktop-buffer-major-mode)
(progn
(let ((first (nth 0 desktop-buffer-misc))
(second (nth 1 desktop-buffer-misc)))
(when (and first second)
(require 'info)
(with-no-warnings
(Info-find-node first second))
(current-buffer))))))
;; ----------------------------------------------------------------------------
(eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
(defun desktop-buffer-rmail () "Load an RMAIL file."
(if (eq 'rmail-mode desktop-buffer-major-mode)
(condition-case error
(progn (rmail-input desktop-buffer-file-name)
(if (eq major-mode 'rmail-mode)
(current-buffer)
rmail-buffer))
(file-locked
(kill-buffer (current-buffer))
'ignored))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-mh () "Load a folder in the mh system."
(if (eq 'mh-folder-mode desktop-buffer-major-mode)
(with-no-warnings
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired () "Load a directory using dired."
(if (eq 'dired-mode desktop-buffer-major-mode)
;; First element of `desktop-buffer-misc' is the value of `dired-directory'.
;; This value is a directory name, optionally with with shell wildcard or
;; a directory name followed by list of files.
(let* ((dired-dir (car desktop-buffer-misc))
(dir (if (consp dired-dir) (car dired-dir) dired-dir)))
(if (file-directory-p (file-name-directory dir))
(progn
(dired dired-dir)
;; The following elements of `desktop-buffer-misc' are the keys
;; from `dired-subdir-alist'.
(mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
(current-buffer))
(message "Directory %s no longer exists." dir)
(sit-for 1)
'ignored))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-file ()
"Load a file."
(defun desktop-restore-file-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore a file buffer."
(eval-when-compile ; Just to silence the byte compiler
(defvar desktop-buffer-major-mode)
(defvar desktop-buffer-locals))
(if desktop-buffer-file-name
(if (or (file-exists-p desktop-buffer-file-name)
(and desktop-missing-file-warning
(y-or-n-p (format
"File \"%s\" no longer exists. Re-create? "
desktop-buffer-file-name))))
(let ((msg (format "Desktop: File \"%s\" no longer exists."
desktop-buffer-file-name)))
(if desktop-missing-file-warning
(y-or-n-p (concat msg " Re-create? "))
(message msg)
nil)))
(let* ((auto-insert nil) ; Disable auto insertion
(coding-system-for-read
(or coding-system-for-read
@ -885,7 +810,7 @@ directory DIRNAME."
(functionp desktop-buffer-major-mode)
(funcall desktop-buffer-major-mode))
buf)
'ignored)))
nil)))
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...; called from Desktop file
@ -907,20 +832,32 @@ directory DIRNAME."
desktop-buffer-misc
&optional
desktop-buffer-locals)
;; Just to silence the byte compiler. Bound locally in `desktop-read'.
(eval-when-compile
(defvar desktop-buffer-ok-count)
(defvar desktop-buffer-fail-count))
;; To make desktop files with relative file names possible, we cannot
;; allow `default-directory' to change. Therefore we save current buffer.
(save-current-buffer
(let (
(buffer-list (buffer-list))
(hlist desktop-buffer-handlers)
(result)
(handler)
(result
(condition-case err
(funcall (or (cdr (assq desktop-buffer-major-mode desktop-buffer-mode-handlers))
'desktop-restore-file-buffer)
desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
(error
(message "Desktop: Can't load buffer %s: %s"
desktop-buffer-name (error-message-string err))
(when desktop-missing-file-warning (sit-for 1))
nil)))
)
;; Call desktop-buffer-handlers to create buffer.
(while (and (not result) hlist)
(setq handler (car hlist))
(setq result (funcall handler))
(setq hlist (cdr hlist)))
(if (bufferp result)
(setq desktop-buffer-ok-count (1+ desktop-buffer-ok-count))
(setq desktop-buffer-fail-count (1+ desktop-buffer-fail-count))
(setq result nil))
(unless (bufferp result) (setq result nil))
;; Restore buffer list order with new buffer at end. Don't change
;; the order for old desktop files (old desktop module behaviour).
@ -947,7 +884,12 @@ directory DIRNAME."
desktop-buffer-minor-modes)))
;; Even though point and mark are non-nil when written by `desktop-save'
;; they may be modified by handlers wanting to set point or mark themselves.
(when desktop-buffer-point (goto-char desktop-buffer-point))
(when desktop-buffer-point
(goto-char
(condition-case err
;; Evaluate point. Thus point can be something like '(search-forward ...
(eval desktop-buffer-point)
(error (message "%s" (error-message-string err)) 1))))
(when desktop-buffer-mark
(if (consp desktop-buffer-mark)
(progn

13
lisp/diff-mode.el
View file

@ -48,7 +48,6 @@
;;
;; - Refine hunk on a word-by-word basis.
;;
;; - Use the new next-error-function to allow C-x `.
;; - Handle `diff -b' output in context->unified.
;;; Code:
@ -886,9 +885,14 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
(diff-fixup-modifs (point) (cdr diff-unhandled-changes)))))
(setq diff-unhandled-changes nil)))
;;;;
;;;; The main function
;;;;
(defun diff-next-error (arg reset)
;; Select a window that displays the current buffer so that point
;; movements are reflected in that window. Otherwise, the user might
;; never see the hunk corresponding to the source she's jumping to.
(pop-to-buffer (current-buffer))
(if reset (goto-char (point-min)))
(diff-hunk-next arg)
(diff-goto-source))
;;;###autoload
(define-derived-mode diff-mode fundamental-mode "Diff"
@ -916,6 +920,7 @@ a diff with \\[diff-reverse-direction]."
;; (set (make-local-variable 'paragraph-separate) paragraph-start)
;; (set (make-local-variable 'page-delimiter) "--- [^\t]+\t")
;; compile support
(set (make-local-variable 'next-error-function) 'diff-next-error)
(when (and (> (point-max) (point-min)) diff-default-read-only)
(toggle-read-only t))

44
lisp/dired.el
View file

@ -1402,6 +1402,8 @@ Keybindings:
(or switches dired-listing-switches))
(set (make-local-variable 'font-lock-defaults)
'(dired-font-lock-keywords t nil nil beginning-of-line))
(set (make-local-variable 'desktop-buffer-misc-data-function)
'dired-desktop-buffer-misc-data)
(dired-sort-other dired-actual-switches t)
(run-mode-hooks 'dired-mode-hook)
(when (featurep 'x-dnd)
@ -3340,7 +3342,49 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(let ((local-file (x-dnd-get-local-file-uri uri)))
(if local-file (dired-dnd-handle-local-file local-file action)
nil)))
;;;; Desktop support
(eval-when-compile (require 'desktop))
(defun dired-desktop-buffer-misc-data (desktop-dirname)
"Auxiliary information to be saved in desktop file."
(cons
;; Value of `dired-directory'.
(if (consp dired-directory)
;; Directory name followed by list of files.
(cons (desktop-file-name (car dired-directory) desktop-dirname)
(cdr dired-directory))
;; Directory name, optionally with with shell wildcard.
(desktop-file-name dired-directory desktop-dirname))
;; Subdirectories in `dired-subdir-alist'.
(cdr
(nreverse
(mapcar
(function (lambda (f) (desktop-file-name (car f) desktop-dirname)))
dired-subdir-alist)))))
;;;###autoload
(defun dired-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore a dired buffer specified in a desktop file."
;; First element of `desktop-buffer-misc' is the value of `dired-directory'.
;; This value is a directory name, optionally with with shell wildcard or
;; a directory name followed by list of files.
(let* ((dired-dir (car desktop-buffer-misc))
(dir (if (consp dired-dir) (car dired-dir) dired-dir)))
(if (file-directory-p (file-name-directory dir))
(progn
(dired dired-dir)
;; The following elements of `desktop-buffer-misc' are the keys
;; from `dired-subdir-alist'.
(mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
(current-buffer))
(message "Desktop: Directory %s no longer exists." dir)
(when desktop-missing-file-warning (sit-for 1))
nil)))
(if (eq system-type 'vax-vms)

5
lisp/emacs-lisp/byte-run.el
View file

@ -134,11 +134,10 @@ The result of the body appears to the compiler as a quoted constant."
;; Remember, it's magic.
(cons 'progn body))
(defun with-no-warnings (&optional first &rest body)
(defun with-no-warnings (&rest body)
"Like `progn', but prevents compiler warnings in the body."
;; The implementation for the interpreter is basically trivial.
(if body (car (last body))
first))
(car (last body)))
;;; I nuked this because it's not a good idea for users to think of using it.

6
lisp/emacs-lisp/bytecomp.el
View file

@ -3716,7 +3716,7 @@ being undefined will be suppressed."
(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
(defun byte-compile-no-warnings (form)
(let (byte-compile-warnings)
(byte-compile-form (cadr form))))
(byte-compile-form (cons 'progn (cdr form)))))
;;; tags
@ -3991,7 +3991,7 @@ already up-to-date."
nil))))
;;;###autoload
(defun batch-byte-recompile-directory ()
(defun batch-byte-recompile-directory (&optional arg)
"Run `byte-recompile-directory' on the dirs remaining on the command line.
Must be used only with `-batch', and kills Emacs on completion.
For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
@ -4002,7 +4002,7 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
(or command-line-args-left
(setq command-line-args-left '(".")))
(while command-line-args-left
(byte-recompile-directory (car command-line-args-left))
(byte-recompile-directory (car command-line-args-left) arg)
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs 0))

49
lisp/emacs-lisp/checkdoc.el
View file

@ -2604,18 +2604,13 @@ This function will not modify `match-data'."
(defun checkdoc-output-mode ()
"Create and setup the buffer used to maintain checkdoc warnings.
\\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location."
(if (get-buffer checkdoc-diagnostic-buffer)
(get-buffer checkdoc-diagnostic-buffer)
(save-excursion
(set-buffer (get-buffer-create checkdoc-diagnostic-buffer))
(kill-all-local-variables)
(setq mode-name "Checkdoc"
major-mode 'checkdoc-output-mode)
(set (make-local-variable 'font-lock-defaults)
'((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
(use-local-map checkdoc-output-mode-map)
(run-hooks 'checkdoc-output-mode-hook)
(current-buffer))))
(kill-all-local-variables)
(setq mode-name "Checkdoc"
major-mode 'checkdoc-output-mode)
(set (make-local-variable 'font-lock-defaults)
'((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
(use-local-map checkdoc-output-mode-map)
(run-mode-hooks 'checkdoc-output-mode-hook))
(defalias 'checkdoc-find-error-mouse 'checkdoc-find-error)
(defun checkdoc-find-error (&optional event)
@ -2634,31 +2629,31 @@ This function will not modify `match-data'."
(defun checkdoc-buffer-label ()
"The name to use for a checkdoc buffer in the error list."
(if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(file-relative-name (buffer-file-name))
(concat "#<buffer "(buffer-name) ">")))
(defun checkdoc-start-section (check-type)
"Initialize the checkdoc diagnostic buffer for a pass.
Create the header so that the string CHECK-TYPE is displayed as the
function called to create the messages."
(checkdoc-output-to-error-buffer
"\n\n\C-l\n*** "
(checkdoc-buffer-label) ": " check-type " V " checkdoc-version))
(let ((dir default-directory)
(label (checkdoc-buffer-label)))
(with-current-buffer (get-buffer-create checkdoc-diagnostic-buffer)
(checkdoc-output-mode)
(setq default-directory dir)
(goto-char (point-max))
(insert "\n\n\C-l\n*** " label ": " check-type " V " checkdoc-version))))
(defun checkdoc-error (point msg)
"Store POINT and MSG as errors in the checkdoc diagnostic buffer."
(setq checkdoc-pending-errors t)
(checkdoc-output-to-error-buffer
"\n" (checkdoc-buffer-label) ":"
(int-to-string (count-lines (point-min) (or point (point-min)))) ": "
msg))
(defun checkdoc-output-to-error-buffer (&rest text)
"Place TEXT into the checkdoc diagnostic buffer."
(save-excursion
(set-buffer (checkdoc-output-mode))
(goto-char (point-max))
(apply 'insert text)))
(let ((text (list "\n" (checkdoc-buffer-label) ":"
(int-to-string
(count-lines (point-min) (or point (point-min))))
": " msg)))
(with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
(goto-char (point-max))
(apply 'insert text))))
(defun checkdoc-show-diagnostics ()
"Display the checkdoc diagnostic buffer in a temporary window."

4
lisp/emacs-lisp/disass.el
View file

@ -4,7 +4,7 @@
;; Author: Doug Cutting <doug@csli.stanford.edu>
;; Jamie Zawinski <jwz@lucid.com>
;; Maintainer: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
;; Keywords: internal
;; This file is part of GNU Emacs.
@ -57,7 +57,7 @@ redefine OBJECT if it is a symbol."
(interactive (list (intern (completing-read "Disassemble function: "
obarray 'fboundp t))
nil 0 t))
(if (consp object)
(if (and (consp object) (not (eq (car object) 'lambda)))
(setq object (list 'lambda () object)))
(or indent (setq indent 0)) ;Default indent to zero
(save-excursion

4
lisp/emacs-lisp/easymenu.el
View file

@ -478,8 +478,8 @@ Do it only if `easy-menu-precalculate-equivalent-keybindings' is on."
(when easy-menu-precalculate-equivalent-keybindings
(if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
(setq menu (symbol-value menu)))
;; x-popup-menu does not exist on tty-only Emacs.
;; (if (keymapp menu) (x-popup-menu nil menu))
(and (keymapp menu) (fboundp 'x-popup-menu)
(x-popup-menu nil menu))
))
(defun add-submenu (menu-path submenu &optional before in-menu)

17
lisp/font-lock.el
View file

@ -1562,17 +1562,17 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
(:foreground "DimGray" :weight bold :slant italic))
(((class grayscale) (background dark))
(:foreground "LightGray" :weight bold :slant italic))
(((class color) (min-colors 88) (background light))
(((class color) (min-colors 88) (background light))
(:foreground "Firebrick"))
(((class color) (min-colors 88) (background dark))
(((class color) (min-colors 88) (background dark))
(:foreground "chocolate1"))
(((class color) (min-colors 16) (background light))
(((class color) (min-colors 16) (background light))
(:foreground "red"))
(((class color) (min-colors 16) (background dark))
(((class color) (min-colors 16) (background dark))
(:foreground "red1"))
(((class color) (min-colors 8) (background light))
(((class color) (min-colors 8) (background light))
(:foreground "red"))
(((class color) (min-colors 8) (background dark))
(((class color) (min-colors 8) (background dark))
(:foreground "red1"))
(t (:weight bold :slant italic)))
"Font Lock mode face used to highlight comments."
@ -1673,13 +1673,14 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
'((((class color) (min-colors 88) (background light)) (:foreground "Red" :weight bold))
(((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
(((class color) (min-colors 16) (background light)) (:foreground "Red" :weight bold))
(((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold)) (((class color) (min-colors 8)) (:foreground "red"))
(((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
(((class color) (min-colors 8)) (:foreground "red"))
(t (:inverse-video t :weight bold)))
"Font Lock mode face used to highlight warnings."
:group 'font-lock-highlighting-faces)
(defface font-lock-preprocessor-face
'((t :inherit 'font-lock-builtin-face))
'((t :inherit font-lock-builtin-face))
"Font Lock mode face used to highlight preprocessor directives."
:group 'font-lock-highlighting-faces)

9
lisp/frame.el
View file

@ -1,6 +1,6 @@
;;; frame.el --- multi-frame management independent of window systems
;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003
;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -131,7 +131,7 @@ use (car ARGS) as a function to do the work.
Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
(if (and args (symbolp (car args)))
(apply (car args) buffer (cdr args))
(let ((window (get-buffer-window buffer t)))
(let ((window (get-buffer-window buffer 0)))
(or
;; If we have a window already, make it visible.
(when window
@ -149,6 +149,7 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
(let* ((pop-up-frames nil) (pop-up-windows t)
special-display-regexps special-display-buffer-names
(window (display-buffer buffer)))
;; Only do it if this is a new window:
;; (set-window-dedicated-p window t)
window))
;; If no window yet, make one in a new frame.
@ -564,7 +565,7 @@ is not considered (see `next-frame')."
(interactive)
(select-window (next-window (selected-window)
(> (minibuffer-depth) 0)
t))
0))
(select-frame-set-input-focus (selected-frame)))
(defun previous-multiframe-window ()
@ -572,7 +573,7 @@ is not considered (see `next-frame')."
(interactive)
(select-window (previous-window (selected-window)
(> (minibuffer-depth) 0)
t))
0))
(select-frame-set-input-focus (selected-frame)))
(defun make-frame-on-display (display &optional parameters)

1
lisp/gnus/mailcap.el
View file

@ -271,6 +271,7 @@ validity. Otherwise, if it is a non-function Lisp symbol or list
whose car is a symbol, it is `eval'led to yield the validity. If it
is a string or list of strings, it represents a shell command to run
to return a true or false shell value for the validity.")
(put 'mailcap-mime-data 'risky-local-variable t)
(defcustom mailcap-download-directory nil
"*Directory to which `mailcap-save-binary-file' downloads files by default.

22
lisp/help-fns.el
View file

@ -63,6 +63,7 @@ With ARG, you are asked to choose which language."
(setq default-directory (expand-file-name "~/"))
(setq buffer-auto-save-file-name nil)
(insert-file-contents (expand-file-name filename data-directory))
(hack-local-variables)
(goto-char (point-min))
(search-forward "\n<<")
(beginning-of-line)
@ -354,16 +355,31 @@ KIND should be `var' for a variable or `subr' for a subroutine."
(when (commandp function)
(let* ((remapped (command-remapping function))
(keys (where-is-internal
(or remapped function) overriding-local-map nil nil)))
(or remapped function) overriding-local-map nil nil))
non-modified-keys)
;; Which non-control non-meta keys run this command?
(dolist (key keys)
(if (member (event-modifiers (aref key 0)) '(nil (shift)))
(push key non-modified-keys)))
(when remapped
(princ "It is remapped to `")
(princ (symbol-name remapped))
(princ "'"))
(when keys
(princ (if remapped " which is bound to " "It is bound to "))
;; FIXME: This list can be very long (f.ex. for self-insert-command).
(princ (mapconcat 'key-description keys ", ")))
(when (or remapped keys)
;; If there are many, remove them from KEYS.
(if (< (length non-modified-keys) 10)
(princ (mapconcat 'key-description keys ", "))
(dolist (key non-modified-keys)
(setq keys (delq key keys)))
(if keys
(progn
(princ (mapconcat 'key-description keys ", "))
(princ ", and many ordinary text characters"))
(princ "many ordinary text characters"))))
(when (or remapped keys non-modified-keys)
(princ ".")
(terpri))))
(let* ((arglist (help-function-arglist def))

11
lisp/help-mode.el
View file

@ -195,14 +195,17 @@ Commands:
;;;###autoload
(defun help-mode-finish ()
(let ((entry (assq (selected-window) view-return-to-alist)))
(if entry (setcdr entry (cons (selected-window)
help-return-method))
(setq view-return-to-alist
(cons (cons (selected-window) help-return-method)
view-return-to-alist))))
(when (eq major-mode 'help-mode)
;; View mode's read-only status of existing *Help* buffer is lost
;; by with-output-to-temp-buffer.
(toggle-read-only 1)
(help-make-xrefs (current-buffer)))
(setq view-return-to-alist
(list (cons (selected-window) help-return-method))))
(help-make-xrefs (current-buffer))))
;; Grokking cross-reference information in doc strings and
;; hyperlinking it.

44
lisp/image.el
View file

@ -176,7 +176,7 @@ means display it in the right marginal area."
;;;###autoload
(defun insert-image (image &optional string area)
(defun insert-image (image &optional string area slice)
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
with a `display' property whose value is the image. STRING is
@ -184,7 +184,12 @@ defaulted if you omit it.
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
means display it in the right marginal area."
means display it in the right marginal area.
SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
specifying the X and Y positions and WIDTH and HEIGHT of image area
to insert. A float value 0.0 - 1.0 means relative to the width or
height of the image; integer values are taken as pixel values."
;; Use a space as least likely to cause trouble when it's a hidden
;; character in the buffer.
(unless string (setq string " "))
@ -204,7 +209,40 @@ means display it in the right marginal area."
(let ((start (point)))
(insert string)
(add-text-properties start (point)
`(display ,image rear-nonsticky (display)))))
`(display ,(if slice
(list (cons 'slice slice) image)
image) rear-nonsticky (display)))))
(defun insert-sliced-image (image &optional string area rows cols)
(unless string (setq string " "))
(unless (eq (car-safe image) 'image)
(error "Not an image: %s" image))
(unless (or (null area) (memq area '(left-margin right-margin)))
(error "Invalid area %s" area))
(if area
(setq image (list (list 'margin area) image))
;; Cons up a new spec equal but not eq to `image' so that
;; inserting it twice in a row (adjacently) displays two copies of
;; the image. Don't try to avoid this by looking at the display
;; properties on either side so that we DTRT more often with
;; cut-and-paste. (Yanking killed image text next to another copy
;; of it loses anyway.)
(setq image (cons 'image (cdr image))))
(let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
(y 0.0) (dy (/ 1.0001 (or rows 1))))
(while (< y 1.0)
(while (< x 1.0)
(let ((start (point)))
(insert string)
(add-text-properties start (point)
`(display ,(list (list 'slice x y dx dy) image)
rear-nonsticky (display)))
(setq x (+ x dx))))
(setq x 0.0
y (+ y dy))
(insert "\n"))))
;;;###autoload

61
lisp/info.el
View file

@ -66,29 +66,29 @@ The Lisp code is executed when the node is selected.")
(put 'Info-enable-active-nodes 'risky-local-variable t)
(defface info-node
'((((class color) (background light)) (:foreground "brown" :weight bold :slant italic))
(((class color) (background dark)) (:foreground "white" :weight bold :slant italic))
(t (:weight bold :slant italic)))
'((((class color) (background light)) :foreground "brown" :weight bold :slant italic)
(((class color) (background dark)) :foreground "white" :weight bold :slant italic)
(t :weight bold :slant italic))
"Face for Info node names."
:group 'info)
(defface info-menu-5
'((((class color)) (:foreground "red1"))
(t (:underline t)))
'((((class color)) :foreground "red1")
(t :underline t))
"Face for every third `*' in an Info menu."
:group 'info)
(defface info-xref
'((((class color) (background light)) (:foreground "blue"))
(((class color) (background dark)) (:foreground "cyan"))
(t (:underline t)))
'((((class color) (background light)) :foreground "blue")
(((class color) (background dark)) :foreground "cyan")
(t :underline t))
"Face for Info cross-references."
:group 'info)
(defface info-xref-visited
'((((class color) (background light)) (:foreground "magenta4"))
(((class color) (background dark)) (:foreground "magenta4"))
(t (:underline t)))
'((t :inherit info-xref)
(((class color) (background light)) :foreground "magenta4")
(((class color) (background dark)) :foreground "magenta4"))
"Face for visited Info cross-references."
:group 'info)
@ -110,12 +110,12 @@ A header-line does not scroll with the rest of the buffer."
:group 'info)
(defface info-header-xref
'((t (:inherit info-xref)))
'((t :inherit info-xref))
"Face for Info cross-references in a node header."
:group 'info)
(defface info-header-node
'((t (:inherit info-node)))
'((t :inherit info-node))
"Face for Info nodes in a node header."
:group 'info)
@ -2907,6 +2907,8 @@ Advanced commands:
;; This is for the sake of the invisible text we use handling titles.
(make-local-variable 'line-move-ignore-invisible)
(setq line-move-ignore-invisible t)
(make-local-variable 'desktop-buffer-misc-data-function)
(setq desktop-buffer-misc-data-function 'Info-desktop-buffer-misc-data)
(add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(Info-set-mode-line)
@ -3111,26 +3113,26 @@ the variable `Info-file-list-for-emacs'."
(Info-goto-emacs-command-node command)))))
(defface Info-title-1-face
'((((type tty pc) (class color)) (:foreground "yellow" :weight bold))
(t (:height 1.2 :inherit Info-title-2-face)))
'((((type tty pc) (class color)) :foreground "yellow" :weight bold)
(t :height 1.2 :inherit Info-title-2-face))
"Face for Info titles at level 1."
:group 'info)
(defface Info-title-2-face
'((((type tty pc) (class color)) (:foreground "lightblue" :weight bold))
(t (:height 1.2 :inherit Info-title-3-face)))
'((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
(t :height 1.2 :inherit Info-title-3-face))
"Face for Info titles at level 2."
:group 'info)
(defface Info-title-3-face
'((((type tty pc) (class color)) (:weight bold))
(t (:height 1.2 :inherit Info-title-4-face)))
'((((type tty pc) (class color)) :weight bold)
(t :height 1.2 :inherit Info-title-4-face))
"Face for Info titles at level 3."
:group 'info)
(defface Info-title-4-face
'((((type tty pc) (class color)) (:weight bold))
(t (:weight bold :inherit variable-pitch)))
'((((type tty pc) (class color)) :weight bold)
(t :weight bold :inherit variable-pitch))
"Face for Info titles at level 4."
:group 'info)
@ -3708,6 +3710,23 @@ BUFFER is the buffer speedbar is requesting buttons for."
"^No \".*\" in index$"))
(add-to-list 'debug-ignored-errors mess))
;;;; Desktop support
(defun Info-desktop-buffer-misc-data (desktop-dirname)
"Auxiliary information to be saved in desktop file."
(list Info-current-file Info-current-node))
;;;###autoload
(defun Info-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an info buffer specified in a desktop file."
(let ((first (nth 0 desktop-buffer-misc))
(second (nth 1 desktop-buffer-misc)))
(when (and first second)
(Info-find-node first second)
(current-buffer))))
(provide 'info)
;;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac

10
lisp/international/mule-cmds.el
View file

@ -1054,7 +1054,7 @@ For a list of useful values for KEY and their meanings,
see `language-info-alist'."
(if (symbolp lang-env)
(setq lang-env (symbol-name lang-env)))
(let ((lang-slot (assoc-ignore-case lang-env language-info-alist)))
(let ((lang-slot (assoc-string lang-env language-info-alist t)))
(if lang-slot
(cdr (assq key (cdr lang-slot))))))
@ -1597,11 +1597,11 @@ to using the function `set-language-environment'."
:link '(custom-manual "(emacs)Language Environments")
:set (lambda (symbol value) (set-language-environment value))
:get (lambda (x)
(or (car-safe (assoc-ignore-case
(or (car-safe (assoc-string
(if (symbolp current-language-environment)
(symbol-name current-language-environment)
current-language-environment)
language-info-alist))
language-info-alist t))
"English"))
;; custom type will be updated with `set-language-info'.
:type (if language-info-alist
@ -1749,7 +1749,7 @@ specifies the character set for the major languages of Western Europe."
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
(setq language-name "English"))
(let ((slot (assoc-ignore-case language-name language-info-alist)))
(let ((slot (assoc-string language-name language-info-alist t)))
(unless slot
(error "Language environment not defined: %S" language-name))
(setq language-name (car slot)))
@ -2282,7 +2282,7 @@ matches are looked for in the coding system list, treating case and
the characters `-' and `_' as insignificant. The coding system base
is returned. Thus, for instance, if charset \"ISO8859-2\",
`iso-latin-2' is returned."
(or (car (assoc-ignore-case charset locale-charset-alist))
(or (car (assoc-string charset locale-charset-alist t))
(let ((cs coding-system-alist)
c)
(while (and (not c) cs)

22
lisp/international/mule-util.el
View file

@ -373,27 +373,7 @@ basis, this may not be accurate."
;; On a window system, a character is displayable if we have
;; a font for that character in the default face of the
;; currently selected frame.
(let ((fontset (frame-parameter (selected-frame) 'font))
font-pattern)
(if (query-fontset fontset)
(setq font-pattern (fontset-font fontset char)))
(or font-pattern
(setq font-pattern (fontset-font "fontset-default" char)))
(if font-pattern
(progn
;; Now FONT-PATTERN is a string or a cons of family
;; field pattern and registry field pattern.
(or (stringp font-pattern)
(let ((family (or (car font-pattern) "*"))
(registry (or (cdr font-pattern) "*")))
(or (string-match "-" family)
(setq family (concat "*-" family)))
(or (string-match "-" registry)
(setq registry (concat registry "-*")))
(setq font-pattern
(format "-%s-*-*-*-*-*-*-*-*-*-*-%s"
family registry))))
(x-list-fonts font-pattern 'default (selected-frame) 1)))))
(car (internal-char-font nil char)))
(t
(let ((coding (terminal-coding-system)))
(if coding

4
lisp/international/mule.el
View file

@ -1401,9 +1401,9 @@ Each element must be one of the names listed in the variable
(let* ((M (char-after (+ pos 4)))
(L (char-after (+ pos 5)))
(encoding (match-string 2))
(encoding-info (assoc-ignore-case
(encoding-info (assoc-string
encoding
ctext-non-standard-encodings-alist))
ctext-non-standard-encodings-alist t))
(coding (if encoding-info
(nth 1 encoding-info)
(setq encoding (intern (downcase encoding)))

32
lisp/international/quail.el
View file

@ -1218,7 +1218,7 @@ selected translation."
(t
(error "Invalid object in Quail map: %s" def))))
(defun quail-lookup-key (key &optional len)
(defun quail-lookup-key (key &optional len not-reset-indices)
"Lookup KEY of length LEN in the current Quail map and return the definition.
The returned value is a Quail map specific to KEY."
(or len
@ -1256,7 +1256,7 @@ The returned value is a Quail map specific to KEY."
(if (and (consp translation) (vectorp (cdr translation)))
(progn
(setq quail-current-translations translation)
(if (quail-forget-last-selection)
(if (and (not not-reset-indices) (quail-forget-last-selection))
(setcar (car quail-current-translations) 0))))))
;; We may have to reform cdr part of MAP.
(if (and (cdr map) (functionp (cdr map)))
@ -1524,6 +1524,28 @@ with more keys."
(let (pos)
(quail-delete-region)
(setq pos (point))
(or enable-multibyte-characters
(let (char)
(if (stringp quail-current-str)
(catch 'tag
(mapc #'(lambda (ch)
(when (/= (unibyte-char-to-multibyte
(multibyte-char-to-unibyte ch))
ch)
(setq char ch)
(throw 'tag nil)))
quail-current-str))
(if (/= (unibyte-char-to-multibyte
(multibyte-char-to-unibyte quail-current-str))
quail-current-str)
(setq char quail-current-str)))
(when char
(message "Can't input %c in the current unibyte buffer" char)
(ding)
(sit-for 2)
(message nil)
(setq quail-current-str nil)
(throw 'quail-tag nil))))
(insert quail-current-str)
(move-overlay quail-overlay pos (point))
(if (overlayp quail-conv-overlay)
@ -2021,7 +2043,7 @@ minibuffer and the selected frame has no other windows)."
(defun quail-get-translations ()
"Return a string containing the current possible translations."
(let ((map (quail-lookup-key quail-current-key))
(let ((map (quail-lookup-key quail-current-key nil t))
(str (copy-sequence quail-current-key)))
(if quail-current-translations
(quail-update-current-translations))
@ -2092,7 +2114,7 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
(quail-setup-completion-buf)
(let ((win (get-buffer-window quail-completion-buf 'visible))
(key quail-current-key)
(map (quail-lookup-key quail-current-key))
(map (quail-lookup-key quail-current-key nil t))
(require-update nil))
(with-current-buffer quail-completion-buf
(if (and win
@ -2673,7 +2695,7 @@ function `quail-install-map' (which see)."
(translation-list nil)
map)
(while (> len 0)
(setq map (quail-lookup-key key len)
(setq map (quail-lookup-key key len t)
len (1- len))
(if map
(let* ((def (quail-map-definition map))

8
lisp/iswitchb.el
View file

@ -300,9 +300,11 @@ example functions that filter buffernames."
(defcustom iswitchb-max-to-show nil
"*If non-nil, limit the number of names shown in the minibuffer.
This can greatly speed up iswitchb if you have a multitude of
buffers open."
:type 'integer
If this value is N, and N is greater than the number of matching
buffers, the first N/2 and the last N/2 matching buffers are
shown. This can greatly speed up iswitchb if you have a
multitude of buffers open."
:type '(choice (const :tag "Show all" nil) integer)
:group 'iswitchb)
(defcustom iswitchb-cannot-complete-hook 'iswitchb-completion-help

17
lisp/mail/rmail.el
View file

@ -3867,6 +3867,23 @@ encoded string (and the same mask) will decode the string."
(setq i (1+ i)))
(concat string-vector)))
;;;; Desktop support
;;;###autoload
(defun rmail-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an rmail buffer specified in a desktop file."
(condition-case error
(progn
(rmail-input desktop-buffer-file-name)
(if (eq major-mode 'rmail-mode)
(current-buffer)
rmail-buffer))
(file-locked
(kill-buffer (current-buffer))
nil)))
(provide 'rmail)
;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c

7
lisp/makefile.w32-in
View file

@ -1,5 +1,5 @@
# Makefile for GNU Emacs on the Microsoft W32 API.
# Copyright (c) 2000-2001 Free Software Foundation, Inc.
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (c) 2000,2001,2004 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@ -161,7 +161,8 @@ WINS=\
progmodes \
term \
textmodes \
toolbar
toolbar \
url
doit:

3
lisp/menu-bar.el
View file

@ -1557,7 +1557,8 @@ Buffers menu is regenerated."
(setq buffers-menu (cons 'keymap (cons "Select Buffer" buffers-menu)))
(define-key (current-global-map) [menu-bar buffer]
(cons "Buffers" buffers-menu)))))
;; Call copy-sequence so the string is not pure.
(cons (copy-sequence "Buffers") buffers-menu)))))
(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)

11
lisp/mh-e/mh-e.el
View file

@ -2441,6 +2441,17 @@ well.")
"^There is no other window$"))
(add-to-list 'debug-ignored-errors mess))
;;;; Desktop support
;;;###autoload
(defun mh-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an mh folder buffer specified in a desktop file."
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))
(provide 'mh-e)
;;; Local Variables:

20
lisp/net/telnet.el
View file

@ -197,18 +197,28 @@ rejecting one login and prompting again for a username and password.")
;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
;;;###autoload
(defun telnet (host)
(defun telnet (host &optional port)
"Open a network login connection to host named HOST (a string).
Optional arg PORT specifies alternative port to connect to.
Interactively, use \\[universal-argument] prefix to be prompted for port number.
Communication with HOST is recorded in a buffer `*PROGRAM-HOST*'
where PROGRAM is the telnet program being used. This program
is controlled by the contents of the global variable `telnet-host-properties',
falling back on the value of the global variable `telnet-program'.
Normally input is edited in Emacs and sent a line at a time."
(interactive "sOpen connection to host: ")
(interactive (list (read-string "Open connection to host: ")
(cond
((null current-prefix-arg) nil)
((consp current-prefix-arg) (read-string "Port: "))
(t (prefix-numeric-value current-prefix-arg)))))
(if (and port (numberp port))
(setq port (int-to-string port)))
(let* ((comint-delimiter-argument-list '(?\ ?\t))
(properties (cdr (assoc host telnet-host-properties)))
(telnet-program (if properties (car properties) telnet-program))
(name (concat telnet-program "-" (comint-arguments host 0 nil) ))
(hname (if port (concat host ":" port) host))
(name (concat telnet-program "-" (comint-arguments hname 0 nil) ))
(buffer (get-buffer (concat "*" name "*")))
(telnet-options (if (cdr properties) (cons "-l" (cdr properties))))
process)
@ -221,7 +231,9 @@ Normally input is edited in Emacs and sent a line at a time."
;; Don't send the `open' cmd till telnet is ready for it.
(accept-process-output process)
(erase-buffer)
(send-string process (concat "open " host "\n"))
(send-string process (concat "open " host
(if port " " "") (or port "")
"\n"))
(telnet-mode)
(setq comint-input-sender 'telnet-simple-send)
(setq telnet-count telnet-initial-count))))

2
lisp/progmodes/cc-cmds.el
View file

@ -1488,7 +1488,7 @@ more \"DWIM:ey\"."
(save-excursion
(beginning-of-line)
(or (not (re-search-backward
sentence-end
(sentence-end)
(c-point 'bopl)
t))
(< (match-end 0)

298
lisp/progmodes/compile.el
View file

@ -125,11 +125,6 @@ describing how the process finished.")
Each function is called with two arguments: the compilation buffer,
and a string describing how the process finished.")
(defvar compilation-last-buffer nil
"The most recent compilation buffer.
A buffer becomes most recent when its compilation is started
or when it is used with \\[next-error] or \\[compile-goto-error].")
(defvar compilation-in-progress nil
"List of compilation processes now running.")
(or (assq 'compilation-in-progress minor-mode-alist)
@ -561,17 +556,13 @@ Faces `compilation-error-face', `compilation-warning-face',
(setq dir (previous-single-property-change (point) 'directory)
dir (if dir (or (get-text-property (1- dir) 'directory)
(get-text-property dir 'directory)))))
(setq file (cons file (car dir)) ; top of dir stack is current
file (or (gethash file compilation-locs)
(puthash file (list file fmt) compilation-locs)))))
(setq file (cons file (car dir)))))
;; This message didn't mention one, get it from previous
(setq file (previous-single-property-change (point) 'message)
file (or (if file
(nth 2 (car (or (get-text-property (1- file) 'message)
(get-text-property file 'message)))))
;; no previous either -- but don't let font-lock fail
(gethash (setq file '("*unknown*")) compilation-locs)
(puthash file (list file fmt) compilation-locs))))
(car (nth 2 (car (or (get-text-property (1- file) 'message)
(get-text-property file 'message))))))
'("*unknown*"))))
;; All of these fields are optional, get them only if we have an index, and
;; it matched some part of the message.
(and line
@ -590,74 +581,84 @@ Faces `compilation-error-face', `compilation-warning-face',
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
2)))
;; Get first already existing marker (if any has one, all have one).
;; Do this first, as the compilation-assq`s may create new nodes.
(let* ((marker-line (car (cddr file))) ; a line structure
(marker (nth 3 (cadr marker-line))) ; its marker
(compilation-error-screen-columns compilation-error-screen-columns)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker) ; no valid marker for this file
(setq loc (or line 1) ; normalize no linenumber to line 1
marker-line)
(catch 'marker ; find nearest loc, at least one exists
(dolist (x (cddr file)) ; loop over lines
(if (> (or (car x) 1) loc) ; still bigger
(setq marker-line x)
(if (or (not marker-line) ; first in list
(> (- (or (car marker-line) 1) loc)
(- loc (or (car x) 1)))) ; current line is nearer
(setq marker-line x))
(throw 'marker t))))
(setq marker (nth 3 (cadr marker-line))
marker-line (car marker-line))
(with-current-buffer (marker-buffer marker)
(save-restriction
(widen)
(goto-char (marker-position marker))
(when (or end-col end-line)
(beginning-of-line (- (or end-line line) marker-line -1))
(if (< end-col 0)
(end-of-line)
(if compilation-error-screen-columns
(move-to-column end-col)
(forward-char end-col)))
(setq end-marker (list (point-marker))))
(beginning-of-line (if end-line
(- end-line line -1)
(- loc marker-line -1)))
(if col
(if compilation-error-screen-columns
(move-to-column col)
(forward-char col))
(forward-to-indentation 0))
(setq marker (list (point-marker))))))
(compilation-internal-error-properties file line end-line col end-col type fmt)))
(setq loc (compilation-assq line (cdr file)))
(if end-line
(setq end-loc (compilation-assq end-line (cdr file))
end-loc (compilation-assq end-col end-loc))
(if end-col ; use same line element
(setq end-loc (compilation-assq end-col loc))))
(setq loc (compilation-assq col loc))
;; If they are new, make the loc(s) reference the file they point to.
(or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
(if end-loc
(or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
(defun compilation-internal-error-properties (file line end-line col end-col type fmt)
"Get the meta-info that will be added as text-properties.
LINE, END-LINE, COL, END-COL are integers or nil.
TYPE can be 0, 1, or 2.
FILE should be (FILENAME . DIRNAME) or nil."
(unless file (setq file '("*unknown*")))
(setq file (or (gethash file compilation-locs)
(puthash file (list file fmt) compilation-locs)))
;; Get first already existing marker (if any has one, all have one).
;; Do this first, as the compilation-assq`s may create new nodes.
(let* ((marker-line (car (cddr file))) ; a line structure
(marker (nth 3 (cadr marker-line))) ; its marker
(compilation-error-screen-columns compilation-error-screen-columns)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker) ; no valid marker for this file
(setq loc (or line 1) ; normalize no linenumber to line 1
marker-line)
(catch 'marker ; find nearest loc, at least one exists
(dolist (x (cddr file)) ; loop over lines
(if (> (or (car x) 1) loc) ; still bigger
(setq marker-line x)
(if (or (not marker-line) ; first in list
(> (- (or (car marker-line) 1) loc)
(- loc (or (car x) 1)))) ; current line is nearer
(setq marker-line x))
(throw 'marker t))))
(setq marker (nth 3 (cadr marker-line))
marker-line (car marker-line))
(with-current-buffer (marker-buffer marker)
(save-restriction
(widen)
(goto-char (marker-position marker))
(when (or end-col end-line)
(beginning-of-line (- (or end-line line) marker-line -1))
(if (< end-col 0)
(end-of-line)
(if compilation-error-screen-columns
(move-to-column end-col)
(forward-char end-col)))
(setq end-marker (list (point-marker))))
(beginning-of-line (if end-line
(- end-line line -1)
(- loc marker-line -1)))
(if col
(if compilation-error-screen-columns
(move-to-column col)
(forward-char col))
(forward-to-indentation 0))
(setq marker (list (point-marker))))))
;; Must start with face
`(face ,compilation-message-face
message (,loc ,type ,end-loc)
,@(if compilation-debug
`(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
,@(match-data))))
help-echo ,(if col
"mouse-2: visit this file, line and column"
(if line
"mouse-2: visit this file and line"
"mouse-2: visit this file"))
keymap compilation-button-map
mouse-face highlight))))
(setq loc (compilation-assq line (cdr file)))
(if end-line
(setq end-loc (compilation-assq end-line (cdr file))
end-loc (compilation-assq end-col end-loc))
(if end-col ; use same line element
(setq end-loc (compilation-assq end-col loc))))
(setq loc (compilation-assq col loc))
;; If they are new, make the loc(s) reference the file they point to.
(or (cdr loc) (setcdr loc `(,line ,file ,@marker)))
(if end-loc
(or (cdr end-loc) (setcdr end-loc `(,(or end-line line) ,file ,@end-marker))))
;; Must start with face
`(face ,compilation-message-face
message (,loc ,type ,end-loc)
,@(if compilation-debug
`(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
,@(match-data))))
help-echo ,(if col
"mouse-2: visit this file, line and column"
(if line
"mouse-2: visit this file and line"
"mouse-2: visit this file"))
keymap compilation-button-map
mouse-face highlight)))
(defun compilation-mode-font-lock-keywords ()
"Return expressions to highlight in Compilation mode."
@ -702,6 +703,9 @@ Faces `compilation-error-face', `compilation-warning-face',
,(if col `(match-string ,col)))))
(,file compilation-error-face t))
(unless (or (null (nth 5 item)) (integerp (nth 5 item)))
(error "HYPERLINK should be an integer: %s" (nth 5 item)))
`(,(nth 0 item)
,@(when (integerp file)
@ -962,7 +966,7 @@ exited abnormally with code %d\n"
(select-window outwin)
(goto-char (point-max))))
;; Make it so the next C-x ` will use this buffer.
(setq compilation-last-buffer outbuf)))
(setq next-error-last-buffer outbuf)))
(defun compilation-set-window-height (window)
"Set the height of WINDOW according to `compilation-window-height'."
@ -1093,6 +1097,10 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)."
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
(compilation-setup)
;; note that compilation-next-error-function is for interfacing
;; with the next-error function in simple.el, and it's only
;; coincidentally named similarly to compilation-next-error
(setq next-error-function 'compilation-next-error-function)
(run-mode-hooks 'compilation-mode-hook))
(defmacro define-compilation-mode (mode name doc &rest body)
@ -1154,7 +1162,6 @@ Optional argument MINOR indicates this is called from
(make-local-variable 'compilation-current-error)
(make-local-variable 'compilation-error-screen-columns)
(make-local-variable 'overlay-arrow-position)
(setq compilation-last-buffer (current-buffer))
(set (make-local-variable 'font-lock-extra-managed-props)
'(directory message help-echo mouse-face debug))
(set (make-local-variable 'compilation-locs)
@ -1271,8 +1278,16 @@ Just inserts the text, but uses `insert-before-markers'."
(insert-before-markers string)
(run-hooks 'compilation-filter-hook))))))
;;; test if a buffer is a compilation buffer, assuming we're in the buffer
(defsubst compilation-buffer-internal-p ()
"Test if inside a compilation buffer."
(local-variable-p 'compilation-locs))
;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
(defsubst compilation-buffer-p (buffer)
(local-variable-p 'compilation-locs buffer))
"Test if BUFFER is a compilation buffer."
(with-current-buffer buffer
(compilation-buffer-internal-p)))
(defmacro compilation-loop (< property-change 1+ error)
`(while (,< n 0)
@ -1303,7 +1318,6 @@ Does NOT find the source line like \\[next-error]."
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
(or pt (setq pt (point)))
(setq compilation-last-buffer (current-buffer))
(let* ((msg (get-text-property pt 'message))
(loc (car msg))
last)
@ -1341,25 +1355,6 @@ Does NOT find the source line like \\[previous-error]."
(interactive "p")
(compilation-next-error (- n)))
(defun next-error-no-select (n)
"Move point to the next error in the compilation buffer and highlight match.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Finds and highlights the source line like \\[next-error], but does not
select the source buffer."
(interactive "p")
(next-error n)
(pop-to-buffer compilation-last-buffer))
(defun previous-error-no-select (n)
"Move point to previous error in compilation buffer and highlight match.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
(interactive "p")
(next-error-no-select (- n)))
(defun compilation-next-file (n)
"Move point to the next error for a different file than the current one.
Prefix arg N says how many files to move forwards (or backwards, if negative)."
@ -1397,55 +1392,17 @@ Use this command in a compilation log buffer. Sets the mark at point there."
;; Return a compilation buffer.
;; If the current buffer is a compilation buffer, return it.
;; If compilation-last-buffer is set to a live buffer, use that.
;; Otherwise, look for a compilation buffer and signal an error
;; if there are none.
(defun compilation-find-buffer (&optional other-buffer)
(if (and (not other-buffer)
(compilation-buffer-p (current-buffer)))
;; The current buffer is a compilation buffer.
(current-buffer)
(if (and compilation-last-buffer (buffer-name compilation-last-buffer)
(compilation-buffer-p compilation-last-buffer)
(or (not other-buffer) (not (eq compilation-last-buffer
(current-buffer)))))
compilation-last-buffer
(let ((buffers (buffer-list)))
(while (and buffers (or (not (compilation-buffer-p (car buffers)))
(and other-buffer
(eq (car buffers) (current-buffer)))))
(setq buffers (cdr buffers)))
(if buffers
(car buffers)
(or (and other-buffer
(compilation-buffer-p (current-buffer))
;; The current buffer is a compilation buffer.
(progn
(if other-buffer
(message "This is the only compilation buffer."))
(current-buffer)))
(error "No compilation started!")))))))
(next-error-find-buffer other-buffer 'compilation-buffer-internal-p))
;;;###autoload
(defun next-error (&optional n)
"Visit next compilation error message and corresponding source code.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
\\[next-error] normally uses the most recently started compilation or
grep buffer. However, it can operate on any buffer with output from
the \\[compile] and \\[grep] commands, or, more generally, on any
buffer in Compilation mode or with Compilation Minor mode enabled. To
specify use of a particular buffer for error messages, type
\\[next-error] in that buffer.
Once \\[next-error] has chosen the buffer for error messages,
it stays with that buffer until you use it in some other buffer which
uses Compilation mode or Compilation Minor mode.
See variable `compilation-error-regexp-alist' for customization ideas."
(defun compilation-next-error-function (n &optional reset)
(interactive "p")
(set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
(set-buffer (compilation-find-buffer))
(when reset
(setq compilation-current-error nil))
(let* ((columns compilation-error-screen-columns) ; buffer's local value
(last 1)
(loc (compilation-next-error (or n 1) nil
@ -1492,27 +1449,6 @@ See variable `compilation-error-regexp-alist' for customization ideas."
(compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
(setcdr (nthcdr 3 loc) t))) ; Set this one as visited.
;;;###autoload (define-key ctl-x-map "`" 'next-error)
(defun previous-error (n)
"Visit previous compilation error message and corresponding source code.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
This operates on the output from the \\[compile] and \\[grep] commands."
(interactive "p")
(next-error (- n)))
(defun first-error (n)
"Restart at the first error.
Visit corresponding source code.
With prefix arg N, visit the source code of the Nth error.
This operates on the output from the \\[compile] command."
(interactive "p")
(set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
(setq compilation-current-error nil)
(next-error n))
(defun compilation-fake-loc (marker file &optional line col)
"Preassociate MARKER with FILE.
This is useful when you compile temporary files, but want
@ -1732,17 +1668,25 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
(defun compilation-compat-error-properties (err)
"Map old-style error ERR to new-style message."
(let* ((dst (cdr err))
(loc (cond ((markerp dst) (list nil nil nil dst))
((consp dst)
(list (nth 2 dst) (nth 1 dst)
(cons (cdar dst) (caar dst)))))))
;; Must start with a face, for font-lock.
`(face nil
message ,(list loc 2)
help-echo "mouse-2: visit the source location"
keymap compilation-button-map
mouse-face highlight)))
;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
;; (MARKER . MARKER).
(let ((dst (cdr err)))
(if (markerp dst)
;; Must start with a face, for font-lock.
`(face nil
message ,(list (list nil nil nil dst) 2)
help-echo "mouse-2: visit the source location"
keymap compilation-button-map
mouse-face highlight)
;; Too difficult to do it by hand: dispatch to the normal code.
(let* ((file (pop dst))
(line (pop dst))
(col (pop dst))
(filename (pop file))
(dirname (pop file))
(fmt (pop file)))
(compilation-internal-error-properties
(cons filename dirname) line nil col nil 2 fmt)))))
(defun compilation-compat-parse-errors (limit)
(when compilation-parse-errors-function

9
lisp/progmodes/cperl-mode.el
View file

@ -926,12 +926,9 @@ the faces: please specify bold, italic, underline, shadow and box.)
(defun cperl-putback-char (c) ; Emacs 19
(set 'unread-command-events (list c))) ; Avoid undefined warning
(if (boundp 'unread-command-events)
(if cperl-xemacs-p
(defun cperl-putback-char (c) ; XEmacs >= 19.12
(setq unread-command-events (list (eval '(character-to-event c))))))
(defun cperl-putback-char (c) ; XEmacs <= 19.11
(set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings
(if cperl-xemacs-p
(defun cperl-putback-char (c) ; XEmacs >= 19.12
(setq unread-command-events (list (eval '(character-to-event c))))))
(or (fboundp 'uncomment-region)
(defun uncomment-region (beg end)

48
lisp/progmodes/gdb-ui.el
View file

@ -1,6 +1,6 @@
;;; gdb-ui.el --- User Interface for running GDB
;; Author: Nick Roberts <nick@nick.uklinux.net>
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: FSF
;; Keywords: unix, tools
@ -1141,10 +1141,18 @@ static char *magick[] = {
(gdb-display-buffer
(gdb-get-create-buffer 'gdb-breakpoints-buffer)))
(defconst gdb-frame-parameters
'((height . 12) (width . 60)
(unsplittable . t)
(tool-bar-lines . nil)
(menu-bar-lines . nil)
(minibuffer . nil)))
(defun gdb-frame-breakpoints-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdb-breakpoints-buffer)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
(defvar gdb-breakpoints-mode-map
(let ((map (make-sparse-keymap))
@ -1264,8 +1272,9 @@ current line."
(defun gdb-frame-stack-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdb-stack-buffer)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdb-stack-buffer))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
(defvar gdb-frames-mode-map
(let ((map (make-sparse-keymap)))
@ -1340,8 +1349,9 @@ the source buffer."
(defun gdb-frame-threads-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdb-threads-buffer)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdb-threads-buffer))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
(defvar gdb-threads-mode-map
(let ((map (make-sparse-keymap)))
@ -1421,8 +1431,9 @@ the source buffer."
(defun gdb-frame-registers-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdb-registers-buffer)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdb-registers-buffer))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
;;
;; Locals buffer.
@ -1492,8 +1503,9 @@ the source buffer."
(defun gdb-frame-locals-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdb-locals-buffer)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdb-locals-buffer))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
;;;; Window management
@ -1514,7 +1526,7 @@ the source buffer."
(set-window-dedicated-p win t))))
(setq answer (get-buffer-window buf))
(if (not answer)
(let ((window (get-lru-window)))
(let ((window (get-lru-window 'visible)))
(if window
(progn
(set-window-buffer window buf)
@ -1525,7 +1537,7 @@ the source buffer."
(if (eq gud-comint-buffer (window-buffer win))
(set-window-dedicated-p win nil)))))
(if must-split
(let* ((largest (get-largest-window))
(let* ((largest (get-largest-window 'visible))
(cur-size (window-height largest))
(new-size (and size (< size cur-size) (- cur-size size))))
(setq answer (split-window largest new-size))
@ -1590,8 +1602,9 @@ the source buffer."
(defun gdb-frame-gdb-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdba)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdba))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
(defun gdb-display-gdb-buffer ()
(interactive)
@ -1920,8 +1933,9 @@ BUFFER nil or omitted means use the current buffer."
(defun gdb-frame-assembler-buffer ()
(interactive)
(switch-to-buffer-other-frame
(gdb-get-create-buffer 'gdb-assembler-buffer)))
(select-frame (make-frame gdb-frame-parameters))
(switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
(set-window-dedicated-p (get-buffer-window (current-buffer)) t))
;; modified because if gdb-current-address has changed value a new command
;; must be enqueued to update the buffer with the new output

2
lisp/progmodes/python.el
View file

@ -1415,7 +1415,7 @@ The criterion is either a match for `jython-mode' via
(while (re-search-forward
(rx (and line-start (or "import" "from") (1+ space)
(group (1+ (not (any " \t\n."))))))
10000 ; Probably not worth customizing.
(+ (point-min) 10000) ; Probably not worth customizing.
t)
(if (member (match-string 1) python-jython-packages)
(throw 'done t))))

17
lisp/recentf.el
View file

@ -1137,13 +1137,16 @@ default."
"Save the recent list.
Write data into the file specified by `recentf-save-file'."
(interactive)
(with-temp-buffer
(erase-buffer)
(insert (format recentf-save-file-header (current-time-string)))
(recentf-dump-variable 'recentf-list recentf-max-saved-items)
(recentf-dump-variable 'recentf-filter-changer-state)
(write-file (expand-file-name recentf-save-file))
nil))
(condition-case error
(with-temp-buffer
(erase-buffer)
(insert (format recentf-save-file-header (current-time-string)))
(recentf-dump-variable 'recentf-list recentf-max-saved-items)
(recentf-dump-variable 'recentf-filter-changer-state)
(write-file (expand-file-name recentf-save-file))
nil)
(error
(warn "recentf mode: %s" (error-message-string error)))))
(defun recentf-load-list ()
"Load a previously saved recent list.

20
lisp/replace.el
View file

@ -538,6 +538,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
(set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
(make-local-variable 'occur-revert-arguments)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(setq next-error-function 'occur-next-error)
(run-hooks 'occur-mode-hook))
(defun occur-revert-function (ignore1 ignore2)
@ -614,6 +615,21 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
"Move to the Nth (default 1) previous match in an Occur mode buffer."
(interactive "p")
(occur-find-match n #'previous-single-property-change "No earlier matches"))
(defun occur-next-error (&optional argp reset)
"Move to the Nth (default 1) next match in an Occur mode buffer.
Compatibility function for \\[next-error] invocations."
(interactive "p")
(when reset
(occur-find-match 0 #'next-single-property-change "No first match"))
(occur-find-match
(prefix-numeric-value argp)
(if (> 0 (prefix-numeric-value argp))
#'previous-single-property-change
#'next-single-property-change)
"No more matches")
(occur-mode-goto-occurrence))
(defcustom list-matching-lines-default-context-lines 0
"*Default number of context lines included around `list-matching-lines' matches.
@ -800,7 +816,9 @@ See also `multi-occur'."
(setq occur-revert-arguments (list regexp nlines bufs)
buffer-read-only t)
(if (> count 0)
(display-buffer occur-buf)
(progn
(display-buffer occur-buf)
(setq next-error-last-buffer occur-buf))
(kill-buffer occur-buf)))
(run-hooks 'occur-hook))))

137
lisp/simple.el
View file

@ -1,7 +1,7 @@
;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
;; 2000, 2001, 2002, 2003
;; 2000, 01, 02, 03, 04
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -66,6 +66,141 @@
(setq list (cdr list)))
(switch-to-buffer found)))
;;; next-error support framework
(defvar next-error-last-buffer nil
"The most recent next-error buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")
(defvar next-error-function nil
"Function to use to find the next error in the current buffer.
The function is called with 2 parameters:
ARG is an integer specifying by how many errors to move.
RESET is a boolean which, if non-nil, says to go back to the beginning
of the errors before moving.
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
(make-variable-buffer-local 'next-error-function)
(defsubst next-error-buffer-p (buffer &optional extra-test)
"Test if BUFFER is a next-error capable buffer."
(with-current-buffer buffer
(or (and extra-test (funcall extra-test))
next-error-function)))
;; Return a next-error capable buffer.
;; If the current buffer is such, return it.
;; If next-error-last-buffer is set to a live buffer, use that.
;; Otherwise, look for a next-error capable buffer and signal an error
;; if there are none.
(defun next-error-find-buffer (&optional other-buffer extra-test)
(if (and (not other-buffer)
(next-error-buffer-p (current-buffer) extra-test))
;; The current buffer is a next-error capable buffer.
(current-buffer)
(if (and next-error-last-buffer (buffer-name next-error-last-buffer)
(next-error-buffer-p next-error-last-buffer extra-test)
(or (not other-buffer) (not (eq next-error-last-buffer
(current-buffer)))))
next-error-last-buffer
(let ((buffers (buffer-list)))
(while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test))
(and other-buffer
(eq (car buffers) (current-buffer)))))
(setq buffers (cdr buffers)))
(if buffers
(car buffers)
(or (and other-buffer
(next-error-buffer-p (current-buffer) extra-test)
;; The current buffer is a next-error capable buffer.
(progn
(if other-buffer
(message "This is the only next-error capable buffer."))
(current-buffer)))
(error "No next-error capable buffer found!")))))))
(defun next-error (arg &optional reset)
"Visit next next-error message and corresponding source code.
If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.
A prefix ARG specifies how many error messages to move;
negative means move back to previous error messages.
Just \\[universal-argument] as a prefix means reparse the error message buffer
and start at the first error.
The RESET argument specifies that we should restart from the beginning
\\[next-error] normally uses the most recently started
compilation, grep, or occur buffer. It can also operate on any
buffer with output from the \\[compile], \\[grep] commands, or,
more generally, on any buffer in Compilation mode or with
Compilation Minor mode enabled, or any buffer in which
`next-error-function' is bound to an appropriate
function. To specify use of a particular buffer for error
messages, type \\[next-error] in that buffer.
Once \\[next-error] has chosen the buffer for error messages,
it stays with that buffer until you use it in some other buffer which
uses Compilation mode or Compilation Minor mode.
See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
(interactive "P")
(if (consp arg) (setq reset t arg nil))
(when (setq next-error-last-buffer (next-error-find-buffer))
;; we know here that next-error-function is a valid symbol we can funcall
(with-current-buffer next-error-last-buffer
(funcall next-error-function (prefix-numeric-value arg) reset))))
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)
(define-key ctl-x-map "`" 'next-error)
(defun previous-error (n)
"Visit previous next-error message and corresponding source code.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
This operates on the output from the \\[compile] and \\[grep] commands."
(interactive "p")
(next-error (- n)))
(defun first-error (n)
"Restart at the first error.
Visit corresponding source code.
With prefix arg N, visit the source code of the Nth error.
This operates on the output from the \\[compile] command, for instance."
(interactive "p")
(next-error n t))
(defun next-error-no-select (n)
"Move point to the next error in the next-error buffer and highlight match.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Finds and highlights the source line like \\[next-error], but does not
select the source buffer."
(interactive "p")
(next-error n)
(pop-to-buffer next-error-last-buffer))
(defun previous-error-no-select (n)
"Move point to the previous error in the next-error buffer and highlight match.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
(interactive "p")
(next-error-no-select (- n)))
;;;
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."

17
lisp/subr.el
View file

@ -644,14 +644,16 @@ and `down'."
(setq type (car type)))
(if (symbolp type)
(cdr (get type 'event-symbol-elements))
(let ((list nil))
(or (zerop (logand type ?\M-\^@))
(let ((list nil)
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
?\H-\^@ ?\s-\^@ ?\A-\^@)))))
(if (not (zerop (logand type ?\M-\^@)))
(setq list (cons 'meta list)))
(or (and (zerop (logand type ?\C-\^@))
(>= (logand type 127) 32))
(if (or (not (zerop (logand type ?\C-\^@)))
(< char 32))
(setq list (cons 'control list)))
(or (and (zerop (logand type ?\S-\^@))
(= (logand type 255) (downcase (logand type 255))))
(if (or (not (zerop (logand type ?\S-\^@)))
(/= char (downcase char)))
(setq list (cons 'shift list)))
(or (zerop (logand type ?\H-\^@))
(setq list (cons 'hyper list)))
@ -1329,7 +1331,8 @@ Optional DEFAULT is a default password to use instead of empty input."
(while
(progn
(let ((str (read-from-minibuffer prompt nil nil nil nil
(number-to-string default))))
(and default
(number-to-string default)))))
(setq n (cond
((zerop (length str)) default)
((stringp str) (read str)))))

10
lisp/textmodes/fill.el
View file

@ -155,7 +155,7 @@ Leave one space between words, two at end of sentences or after colons
and `sentence-end-without-period').
Remove indentation from each line."
(interactive "*r")
(let ((end-spc-re (concat "\\(" sentence-end "\\) *\\| +")))
(let ((end-spc-re (concat "\\(" (sentence-end) "\\) *\\| +")))
(save-excursion
(goto-char beg)
;; Nuke tabs; they get screwed up in a fill.
@ -349,7 +349,7 @@ and `fill-nobreak-invisible'."
(save-excursion
(skip-chars-backward ". ")
(and (looking-at "\\.")
(not (looking-at sentence-end))))
(not (looking-at (sentence-end)))))
;; Don't split a line if the rest would look like a new paragraph.
(unless use-hard-newlines
(save-excursion
@ -424,10 +424,10 @@ Point is moved to just past the fill prefix on the first line."
;; loses on split abbrevs ("Mr.\nSmith")
(let ((eol-double-space-re
(cond
((not colon-double-space) (concat sentence-end "$"))
((not colon-double-space) (concat (sentence-end) "$"))
;; Try to add the : inside the `sentence-end' regexp.
((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" sentence-end)
(concat (replace-match ".:" nil nil sentence-end 1) "$"))
((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" (sentence-end))
(concat (replace-match ".:" nil nil (sentence-end) 1) "$"))
;; Can't find the right spot to insert the colon.
(t "[.?!:][])}\"']*$")))
(sentence-end-without-space-list

62
lisp/textmodes/paragraphs.el
View file

@ -120,49 +120,62 @@ text indented by a margin setting."
This is relevant for filling. See also `sentence-end-without-period'
and `colon-double-space'.
If you change this, you should also change `sentence-end'. See Info
node `Sentences'."
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, in case when the value of
the variable `sentence-end' is nil. See Info node `Sentences'."
:type 'boolean
:group 'fill)
(defcustom sentence-end-without-period nil
"*Non-nil means a sentence will end without a period.
For example, a sentence in Thai text ends with double space but
without a period."
without a period.
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, in case when the value of
the variable `sentence-end' is nil. See Info node `Sentences'."
:type 'boolean
:group 'fill)
(defcustom sentence-end-without-space
"$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B"
"*String containing characters that end sentence without following spaces.
If you change this, you should also change `sentence-end'. See Info
node `Sentences'."
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, in case when the value of
the variable `sentence-end' is nil. See Info node `Sentences'."
:group 'paragraphs
:type 'string)
(defcustom sentence-end
(purecopy
;; This is a bit stupid since it's not auto-updated when the
;; other variables are changes, but it's still useful info.
(concat (if sentence-end-without-period "\\w \\|")
"\\([.?!][]\"')}]*"
(if sentence-end-double-space
"\\($\\| $\\|\t\\| \\)" "\\($\\|[\t ]\\)")
"\\|[" sentence-end-without-space "]+\\)"
"[ \t\n]*"))
(defcustom sentence-end nil
"*Regexp describing the end of a sentence.
The value includes the whitespace following the sentence.
All paragraph boundaries also end sentences, regardless.
The default value specifies that in order to be recognized as the end
of a sentence, the ending period, question mark, or exclamation point
must be followed by two spaces, unless it's inside some sort of quotes
or parenthesis.
See also the variable `sentence-end-double-space', the variable
`sentence-end-without-period' and Info node `Sentences'."
The value nil means to use the default value defined by the
function `sentence-end'. You should always use this function
to obtain the value of this variable."
:group 'paragraphs
:type 'regexp)
:type '(choice regexp (const :tag "Use default value" nil)))
(defun sentence-end ()
"Return the regexp describing the end of a sentence.
This function returns either the value of the variable `sentence-end'
if it is non-nil, or the default value constructed from the
variables `sentence-end-double-space', `sentence-end-without-period'
and `sentence-end-without-space'. The default value specifies
that in order to be recognized as the end of a sentence, the
ending period, question mark, or exclamation point must be
followed by two spaces, unless it's inside some sort of quotes or
parenthesis. See Info node `Sentences'."
(or sentence-end
(concat (if sentence-end-without-period "\\w \\|")
"\\([.?!][]\"')}]*"
(if sentence-end-double-space
"\\($\\| $\\|\t\\| \\)" "\\($\\|[\t ]\\)")
"\\|[" sentence-end-without-space "]+\\)"
"[ \t\n]*")))
(defcustom page-delimiter "^\014"
"*Regexp describing line-beginnings that separate pages."
@ -411,7 +424,8 @@ The variable `sentence-end' is a regular expression that matches ends of
sentences. Also, every paragraph boundary terminates sentences as well."
(interactive "p")
(or arg (setq arg 1))
(let ((opoint (point)))
(let ((opoint (point))
(sentence-end (sentence-end)))
(while (< arg 0)
(let ((pos (point))
(par-beg (save-excursion (start-of-paragraph-text) (point))))

15
lisp/vc-svn.el
View file

@ -334,21 +334,22 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;;; History functions
;;;
(defun vc-svn-print-log (file)
(defun vc-svn-print-log (file &optional buffer)
"Get change log associated with FILE."
(save-current-buffer
(vc-setup-buffer nil)
(vc-setup-buffer buffer)
(let ((inhibit-read-only t))
(goto-char (point-min))
;; Add a line to tell log-view-mode what file this is.
(insert "Working file: " (file-relative-name file) "\n"))
(vc-svn-command
t
buffer
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
file "log")))
(defun vc-svn-diff (file &optional oldvers newvers)
(defun vc-svn-diff (file &optional oldvers newvers buffer)
"Get a difference report using SVN between two versions of FILE."
(unless buffer (setq buffer "*vc-diff*"))
(if (string= (vc-workfile-version file) "0")
;; This file is added but not yet committed; there is no master file.
(if (or oldvers newvers)
@ -356,7 +357,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;; We regard this as "changed".
;; Diff it against /dev/null.
;; Note: this is NOT a "svn diff".
(apply 'vc-do-command "*vc-diff*"
(apply 'vc-do-command buffer
1 "diff" file
(append (vc-switches nil 'diff) '("/dev/null")))
;; Even if it's empty, it's locally modified.
@ -365,7 +366,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(async (and (vc-stay-local-p file)
(or oldvers newvers) ; Svn diffs those locally.
(fboundp 'start-process))))
(apply 'vc-svn-command "*vc-diff*"
(apply 'vc-svn-command buffer
(if async 'async 0)
file "diff"
(append
@ -377,7 +378,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(if async 1 ; async diff => pessimistic assumption
;; For some reason `svn diff' does not return a useful
;; status w.r.t whether the diff was empty or not.
(buffer-size (get-buffer "*vc-diff*"))))))
(buffer-size (get-buffer buffer))))))
(defun vc-svn-diff-tree (dir &optional rev1 rev2)
"Diff all files at and below DIR."

1
lisp/view.el
View file

@ -137,6 +137,7 @@ subtracted from by `view-mode-exit' when finished viewing the buffer.
See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of
`view-return-to-alist'.")
(make-variable-buffer-local 'view-return-to-alist)
(put 'view-return-to-alist 'permanent-local t)
(defvar view-exit-action nil
"nil or a function with one argument (a buffer) called when finished viewing.

5
lisp/window.el
View file

@ -327,8 +327,9 @@ new mode line."
(with-current-buffer (window-buffer)
(if view-mode
(let ((old-info (assq old-w view-return-to-alist)))
(push (cons new-w (cons (and old-info (car (cdr old-info))) t))
view-return-to-alist)))
(if old-info
(push (cons new-w (cons (car (cdr old-info)) t))
view-return-to-alist))))
new-w))
(defun split-window-horizontally (&optional arg)

18
lisp/x-dnd.el
View file

@ -309,14 +309,13 @@ and must have the format file:file-name or file:///file-name.
The last / in file:/// is part of the file name. ACTION is ignored."
(let* ((f (x-dnd-get-local-file-name uri t)))
(when f
(if (file-readable-p f)
(progn
(if x-dnd-open-file-other-window
(find-file-other-window f)
(find-file f))
'private)
(error "Can not read %s (%s)" f uri)))))
(if (and f (file-readable-p f))
(progn
(if x-dnd-open-file-other-window
(find-file-other-window f)
(find-file f))
'private)
(error "Can not read %s" uri))))
(defun x-dnd-open-file (uri action)
"Open a local or remote file.
@ -328,7 +327,8 @@ The last / in file://hostname/ is part of the file name."
;; The hostname may be our hostname, in that case, convert to a local
;; file. Otherwise return nil.
(let ((local-file (x-dnd-get-local-file-uri uri)))
(when local-file (x-dnd-open-local-file local-file action))))
(if local-file (x-dnd-open-local-file local-file action)
(error "Remote files not supported"))))
(defun x-dnd-handle-moz-url (window action data)

4
lispintro/ChangeLog
View file

@ -1,3 +1,7 @@
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-02-29 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in (mostlyclean, clean, maintainer-clean): Use

2
lispintro/makefile.w32-in
View file

@ -1,4 +1,4 @@
#### Makefile for the Emacs Lisp Introduction manual
#### -*- Makefile -*- for the Emacs Lisp Introduction manual.
# Copyright (C) 2003 Free Software Foundation, Inc.

4
lispref/ChangeLog
View file

@ -1,3 +1,7 @@
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-04-18 Jesper Harder <harder@ifa.au.dk>
* tips.texi (Coding Conventions): defopt -> defcustom.

2
lispref/makefile.w32-in
View file

@ -1,4 +1,4 @@
# Makefile for the GNU Emacs Lisp Reference Manual.
# -*- Makefile -*- for the GNU Emacs Lisp Reference Manual.
# Copyright (C) 2003
# Free Software Foundation, Inc.

4
man/ChangeLog
View file

@ -1,3 +1,7 @@
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-04-18 Juri Linkov <juri@jurta.org>
* fixit.texi (Spelling): Remove file extension from ispell xref.

2
man/makefile.w32-in
View file

@ -1,4 +1,4 @@
#### Makefile for the Emacs Manual and other documentation.
#### -*- Makefile -*- for the Emacs Manual and other documentation.
# Copyright (C) 2003
# Free Software Foundation, Inc.

47
man/widget.texi
View file

@ -680,7 +680,7 @@ image, with either a @file{.xpm} (if supported) or @file{.xbm} extension.
@end deffn
@deffn{User Option} widget-glyph-enable
If non-nil, allow glyphs to appear on displays where they are supported.
If non-@code{nil}, allow glyphs to appear on displays where they are supported.
@end deffn
@ -813,7 +813,7 @@ Face used for highlighting the editable field. Default is
@item :secret
Character used to display the value. You can set this to e.g.@: @code{?*}
if the field contains a password or other secret information. By
default, this is nil, and the value is not secret.
default, this is @code{nil}, and the value is not secret.
@vindex valid-regexp@r{ keyword}
@item :valid-regexp
@ -865,12 +865,12 @@ specified @var{type} arguments.
@vindex case-fold@r{ keyword}
@item :case-fold
Set this to nil if you don't want to ignore case when prompting for a
Set this to @code{nil} if you don't want to ignore case when prompting for a
choice through the minibuffer.
@vindex children@r{ keyword}
@item :children
A list whose @code{car} is the widget representing the currently chosen
A list whose @sc{car} is the widget representing the currently chosen
type in the buffer.
@vindex choice@r{ keyword}
@ -1064,9 +1064,9 @@ Insert a literal @samp{%}.
@item :greedy
Usually a checklist will only match if the items are in the exact
sequence given in the specification. By setting @code{:greedy} to
non-nil, it will allow the items to come in any sequence. However, if
you extract the value they will be in the sequence given in the
checklist, i.e.@: the original sequence is forgotten.
non-@code{nil}, it will allow the items to come in any sequence.
However, if you extract the value they will be in the sequence given
in the checklist, i.e.@: the original sequence is forgotten.
@vindex button-args@r{ keyword}
@item :button-args
@ -1141,7 +1141,7 @@ The widgets representing the elements of the list.
@vindex args@r{ keyword}
@item :args
List whose @code{car} is the type of the list elements.
List whose @sc{car} is the type of the list elements.
@end table
@node group, , editable-list, Basic Types
@ -1164,7 +1164,7 @@ The value is a list, with one member for each @var{type}.
@section Sexp Types
@cindex sexp types
A number of widgets for editing @dfn{s-expressions} (lisp types), sexp
A number of widgets for editing @dfn{s-expressions} (Lisp types), sexp
for short, are also available. These basically fall in several
categories described in this section.
@ -1180,7 +1180,7 @@ categories described in this section.
@subsection The Constant Widgets
@cindex constant widgets
The @code{const} widget can contain any lisp expression, but the user is
The @code{const} widget can contain any Lisp expression, but the user is
prohibited from editing it, which is mainly useful as a component of one
of the composite widgets.
@ -1217,7 +1217,7 @@ An immutable symbol that is bound as a function.
@subsection Generic Sexp Widget
@cindex generic sexp widget
The @code{sexp} widget can contain any lisp expression, and allows the
The @code{sexp} widget can contain any Lisp expression, and allows the
user to edit it inline in the buffer.
The syntax for the @code{sexp} widget is:
@ -1278,8 +1278,8 @@ Keywords:
@table @code
@vindex must-match@r{ keyword}
@item :must-match
If this is set to non-nil, only existing file names will be allowed in
the minibuffer.
If this is set to non-@code{nil}, only existing file names will be
allowed in the minibuffer.
@end table
@end deffn
@ -1289,7 +1289,7 @@ Similar to the @code{file} widget.
@end deffn
@deffn Widget symbol
Allows you to edit a lisp symbol in an editable field.
Allows you to edit a Lisp symbol in an editable field.
@end deffn
@deffn Widget function
@ -1309,8 +1309,8 @@ Allows you to edit a number in an editable field.
@end deffn
@deffn Widget boolean
Allows you to edit a boolean. In lisp this means a variable which is
either nil meaning false, or non-nil meaning true.
Allows you to edit a boolean. In Lisp this means a variable which is
either @code{nil} meaning false, or non-@code{nil} meaning true.
@end deffn
@ -1330,8 +1330,8 @@ where each @var{component} must be a widget type. Each component widget
will be displayed in the buffer, and will be editable by the user.
@deffn Widget cons
The value of a @code{cons} widget is a cons-cell where the @code{car} is
the value of the first component and the @code{cdr} is the value of the
The value of a @code{cons} widget is a cons-cell where the @sc{car} is
the value of the first component and the @sc{cdr} is the value of the
second component. There must be exactly two components.
@end deffn
@ -1432,7 +1432,8 @@ In @var{widget} return the value for @var{property}.
@end defun
@defun widget-member widget property
Non-nil if @var{widget} has a value (even nil) for property @var{property}.
Non-@code{nil} if @var{widget} has a value (even @code{nil}) for
property @var{property}.
@end defun
Occasionally it can be useful to know which kind of widget you have,
@ -1475,7 +1476,7 @@ all its ancestors.
@end lisp
You can check if a widget has been made inactive by examining the value
of the @code{:inactive} keyword. If this is non-nil, the widget itself
of the @code{:inactive} keyword. If this is non-@code{nil}, the widget itself
has been deactivated. This is different from using the @code{:active}
keyword, in that the latter tells you if the widget @strong{or} any of
its ancestors have been deactivated. Do not attempt to set the
@ -1500,7 +1501,7 @@ Define a new widget type named @var{name} from @code{class}.
@var{name} and class should both be symbols, @code{class} should be one
of the existing widget types.
The third argument @var{DOC} is a documentation string for the widget.
The third argument @var{doc} is a documentation string for the widget.
After the new widget has been defined, the following two calls will
create identical widgets:
@ -1653,7 +1654,7 @@ Function to prompt for a value in the minibuffer. The function should
take four arguments, @var{widget}, @var{prompt}, @var{value}, and
@var{unbound} and should return a value for widget entered by the user.
@var{prompt} is the prompt to use. @var{value} is the default value to
use, unless @var{unbound} is non-nil, in which case there is no default
use, unless @var{unbound} is non-@code{nil}, in which case there is no default
value. The function should read the value using the method most natural
for this widget, and does not have to check that it matches.
@end table
@ -1719,7 +1720,7 @@ Keymap used in @code{widget-minor-mode}.
@defun widget-prompt-value widget prompt [ value unbound ]
Prompt for a value matching @var{widget}, using @var{prompt}.
The current value is assumed to be @var{value}, unless @var{unbound} is
non-nil.@refill
non-@code{nil}.@refill
@end defun
@defun widget-get-sibling widget

8
nt/ChangeLog
View file

@ -1,3 +1,11 @@
2004-04-23 Juanma Barranquero <lektu@terra.es>
* nmake.defs:
* gmake.defs:
* makefile.w32-in:
* makefile.def:
* makefile.nt: Add "-*- makefile -*-" mode tag.
2004-04-10 Benjamin Riefenstahl <Benjamin.Riefenstahl@epost.de>
* runemacs.c (WinMain): Let emacs environment default to parent.

3
nt/gmake.defs
View file

@ -1,5 +1,4 @@
#
# Makefile definition file for building GNU Emacs on the Microsoft W32 API.
# -*- Makefile -*- definition file for building GNU Emacs on Windows NT.
# Copyright (c) 2000-2001 Free Software Foundation, Inc.
#
# GNU Emacs is free software; you can redistribute it and/or modify

3
nt/makefile.def
View file

@ -1,5 +1,4 @@
#
# Makefile definition file for building GNU Emacs on Windows NT
# -*- Makefile -*- definition file for building GNU Emacs on Windows NT
# Copyright (c) 1994-2001 Free Software Foundation, Inc.
#
# GNU Emacs is free software; you can redistribute it and/or modify

3
nt/makefile.nt
View file

@ -1,5 +1,4 @@
#
# Top level makefile for building GNU Emacs on Windows NT
# Top level -*- makefile -*- for building GNU Emacs on Windows NT
# Copyright (c) 1993-2000 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.

2
nt/makefile.w32-in
View file

@ -1,4 +1,4 @@
# Makefile for GNU Emacs on the Microsoft W32 API.
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (c) 2000-2001 Free Software Foundation, Inc.
#
# Top level makefile for building GNU Emacs on Windows NT

3
nt/nmake.defs
View file

@ -1,5 +1,4 @@
#
# Makefile definition file for building GNU Emacs on the Microsoft W32 API.
# -*- Makefile -*- definition file for building GNU Emacs on Windows NT.
# Copyright (c) 2000-2001 Free Software Foundation, Inc.
#
# GNU Emacs is free software; you can redistribute it and/or modify

121
src/ChangeLog
View file

@ -1,3 +1,110 @@
2004-04-23 Kenichi Handa <handa@m17n.org>
* fontset.c (Finternal_char_font): If POSITION is nil, return
font for displaying CH with the default face.
2004-04-23 Juanma Barranquero <lektu@terra.es>
* makefile.w32-in: Add "-*- makefile -*-" mode tag.
2004-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp.h (XINT) [EXPLICIT_SIGN_EXTEND && !NO_UNION_TYPE]:
Don't make assumptions about the relative place of i and val.
(EQ) [!NO_UNION_TYPE]: Don't forget to check the type match as well.
2004-04-21 Kim F. Storm <storm@cua.dk>
* dispextern.h (struct glyph_slice): New struct.
(struct glyph): New member slice.
(GLYPH_SLICE_EQUAL_P): New macro.
(GLYPH_EQUAL_P): Use it.
(struct glyph_string): New member slice.
(struct it_slice): New struct.
(struct it): New member slice, add member to stack too.
New member constrain_row_ascent_descent_p.
(image_ascent): Add prototype.
* dispnew.c (buffer_posn_from_coords): Return full image width
and height even for image slices (posn is relative to full image).
(marginal_area_string): Adjust x0,y0 for image slice.
* image.c (image_ascent): Add slice arg; calculate ascent for
image slice (or full image).
* keyboard.c (Fposn_at_x_y, Fposn_at_point): New defuns.
(syms_of_keyboard): Defsubr them.
* lisp.h (pos_visible_p): Fix prototype.
* macterm.c (x_draw_relief_rect): Add top_p and bot_p args.
(x_draw_glyph_string_box): Fix call to x_draw_relief_rect.
(x_draw_image_foreground, x_draw_image_relief)
(x_draw_image_foreground_1, x_draw_image_glyph_string):
Draw sliced images.
* w32term.c (w32_draw_relief_rect): Add top_p and bot_p args.
(x_draw_glyph_string_box): Fix call to x_draw_relief_rect.
(x_draw_image_foreground, x_draw_image_relief)
(w32_draw_image_foreground_1, x_draw_image_glyph_string):
Draw sliced images.
* w32term.h (image_ascent): Remove prototype.
* window.c (Fpos_visible_in_window_p): Return pixel position if
PARTIALLY arg is non-nil. Simplify. Doc fix.
(Fwindow_vscroll, Fset_window_vscroll): Add optional PIXEL_P arg
to return/set vscroll in pixels.
* window.h (Fwindow_vscroll, Fset_window_vscroll): Fix EXFUN.
* xdisp.c (Qslice): New variable.
(syms_of_xdisp): Intern and staticpro it.
(pos_visible_p): Return pixel position in new x and y args.
(init_iterator): Reset it->slice info.
(handle_display_prop): Parse (slice ...) property.
(push_it, pop_it): Save/restore slice info.
(make_cursor_line_fully_visible): Fix 2004-04-14 change. Do not
force repositioning of tall row if window is vscrolled, as that
would reset vscroll.
(append_space): Set it->constrain_row_ascent_descent_p to avoid
increasing row height if row is non-empty.
(fill_image_glyph_string): Copy slice info.
(take_vertical_position_into_account): Simplify.
(produce_image_glyph): Handle iterator slice info, setup glyph
slice info. Do not force minimum line height.
(x_produce_glyphs): If it->constrain_row_ascent_descent_p is set,
do not increase height (ascent/descent) of non-empty row when
adding normal character glyph; instead reduce glyph ascent/descent
appropriately; if row is higher than current glyph, adjust glyph
descent/ascent to reposition glyph within the existing row.
Likewise, when char is newline, only set ascent/descent if row is
currently empty.
(note_mouse_highlight): Handle hotspots with sliced image.
* xterm.c (x_draw_relief_rect): Add top_p and bot_p args.
(x_draw_glyph_string_box): Fix call to x_draw_relief_rect.
(x_draw_image_foreground, x_draw_image_relief)
(x_draw_image_foreground_1, x_draw_image_glyph_string):
Draw sliced images.
* xterm.h (image_ascent): Remove prototype.
2004-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
* keymap.c (Fkey_description): Fix the usual int/Lisp_Object mixup.
2004-04-20 John Paul Wallington <jpw@gnu.org>
* fns.c (Fassoc, Feql): Fix indentation.
* fontset.c (regularize_fontname): Rename from regulalize_fontname.
2004-04-19 John Paul Wallington <jpw@gnu.org>
* fns.c (Feql): New function.
(syms_of_fns): Defsubr it.
2004-04-18 Jason Rumney <jasonr@gnu.org>
* w32select.c (Fw32_set_clipboard_data): Get sequence number
@ -8461,16 +8568,16 @@
2002-07-11 Juanma Barranquero <lektu@terra.es>
* alloc.c, buffer.c, bytecode.c, callint.c, callproc.c, coding.c,
* composite.c, dired.c, dispnew.c, editfns.c, emacs.c, eval.c,
* fileio.c, fns.c, insdel.c, keyboard.c, keymap.c, lread.c, macfns.c,
* macmenu.c, macros.c, minibuf.c, print.c, process.c, sound.c,
* textprop.c, w32fns.c, w32menu.c, window.c, xfaces.c, xfns.c,
* xmenu.c, xselect.c, xterm.c: Use SPECPDL_INDEX wherever makes sense.
composite.c, dired.c, dispnew.c, editfns.c, emacs.c, eval.c,
fileio.c, fns.c, insdel.c, keyboard.c, keymap.c, lread.c, macfns.c,
macmenu.c, macros.c, minibuf.c, print.c, process.c, sound.c,
textprop.c, w32fns.c, w32menu.c, window.c, xfaces.c, xfns.c,
xmenu.c, xselect.c, xterm.c: Use SPECPDL_INDEX wherever makes sense.
2002-07-10 Juanma Barranquero <lektu@terra.es>
* lisp.h (SPECPDL_INDEX): Rename from BINDING_STACK_SIZE. All callers
changed.
* lisp.h (SPECPDL_INDEX): Rename from BINDING_STACK_SIZE.
All callers changed.
2002-07-09 Stefan Monnier <monnier@cs.yale.edu>

54
src/dispextern.h
View file

@ -274,6 +274,17 @@ enum glyph_type
};
/* Structure describing how to use partial glyphs (images slicing) */
struct glyph_slice
{
unsigned x : 16;
unsigned y : 16;
unsigned width : 16;
unsigned height : 16;
};
/* Glyphs.
Be extra careful when changing this structure! Esp. make sure that
@ -352,6 +363,8 @@ struct glyph
w32_char_font_type. Otherwise it equals FONT_TYPE_UNKNOWN. */
unsigned font_type : 3;
struct glyph_slice slice;
/* A union of sub-structures for different glyph types. */
union
{
@ -390,11 +403,20 @@ struct glyph
#define CHAR_GLYPH_SPACE_P(GLYPH) \
(GLYPH_FROM_CHAR_GLYPH ((GLYPH)) == SPACEGLYPH)
/* Are glyph slices of glyphs *X and *Y equal */
#define GLYPH_SLICE_EQUAL_P(X, Y) \
((X)->slice.x == (Y)->slice.x \
&& (X)->slice.y == (Y)->slice.y \
&& (X)->slice.width == (Y)->slice.width \
&& (X)->slice.height == (Y)->slice.height)
/* Are glyphs *X and *Y displayed equal? */
#define GLYPH_EQUAL_P(X, Y) \
((X)->type == (Y)->type \
&& (X)->u.val == (Y)->u.val \
&& GLYPH_SLICE_EQUAL_P (X, Y) \
&& (X)->face_id == (Y)->face_id \
&& (X)->padding_p == (Y)->padding_p \
&& (X)->left_box_line_p == (Y)->left_box_line_p \
@ -1139,6 +1161,9 @@ struct glyph_string
/* Image, if any. */
struct image *img;
/* Slice */
struct glyph_slice slice;
struct glyph_string *next, *prev;
};
@ -1607,7 +1632,7 @@ extern int face_change_count;
width and height of the bitmap, DH is the height adjustment (if
bitmap is periodic). X and Y are frame coordinates of the area to
display the bitmap, DY is relative offset of the bitmap into that
area. BX, NX, BY, NY specifies the area to clear if the bitmap
area. BX, NX, BY, NY specifies the area to clear if the bitmap
does not fill the entire area. FACE is the fringe face. */
struct draw_fringe_bitmap_params
@ -1718,6 +1743,15 @@ enum prop_idx
};
struct it_slice
{
Lisp_Object x;
Lisp_Object y;
Lisp_Object width;
Lisp_Object height;
};
struct it
{
/* The window in which we iterate over current_buffer (or a string). */
@ -1830,6 +1864,7 @@ struct it
unsigned multibyte_p : 1;
unsigned string_from_display_prop_p : 1;
unsigned display_ellipsis_p : 1;
struct it_slice slice;
Lisp_Object space_width;
short voffset;
Lisp_Object font_height;
@ -1884,6 +1919,10 @@ struct it
skipped due to selective display. */
unsigned face_before_selective_p : 1;
/* If 1, adjust current glyph so it does not increase current row
descent/ascent. */
unsigned constrain_row_ascent_descent_p : 1;
/* The ID of the default face to use. One of DEFAULT_FACE_ID,
MODE_LINE_FACE_ID, etc, depending on what we are displaying. */
int base_face_id;
@ -1909,6 +1948,9 @@ struct it
/* If what == IT_IMAGE, the id of the image to display. */
int image_id;
/* Values from `slice' property. */
struct it_slice slice;
/* Value of the `space-width' property, if any; nil if none. */
Lisp_Object space_width;
@ -2176,7 +2218,7 @@ struct redisplay_interface
int (*encode_char) P_ ((int c, XChar2b *char2b,
struct font_info *font_into, int *two_byte_p));
/* Compute left and right overhang of glyph string S.
/* Compute left and right overhang of glyph string S.
A NULL pointer if platform does not support this. */
void (*compute_glyph_string_overhangs) P_ ((struct glyph_string *s));
@ -2204,7 +2246,7 @@ struct redisplay_interface
void (*draw_vertical_window_border) P_ ((struct window *w,
int x, int y0, int y1));
/* Shift display of frame F to make room for inserted glyphs.
/* Shift display of frame F to make room for inserted glyphs.
The area at pixel (X,Y) of width WIDTH and height HEIGHT is
shifted right by SHIFT_BY pixels. */
void (*shift_glyphs_for_insert) P_ ((struct frame *f,
@ -2519,7 +2561,7 @@ extern void add_to_log P_ ((char *, Lisp_Object, Lisp_Object));
extern int help_echo_showing_p;
extern int current_mode_line_height, current_header_line_height;
extern Lisp_Object help_echo_string, help_echo_window;
extern Lisp_Object help_echo_object, previous_help_echo_string;
extern Lisp_Object help_echo_object, previous_help_echo_string;
extern int help_echo_pos;
extern struct frame *last_mouse_frame;
extern int last_tool_bar_item;
@ -2629,6 +2671,8 @@ unsigned long image_background P_ ((struct image *, struct frame *,
int image_background_transparent P_ ((struct image *, struct frame *,
XImagePtr_or_DC mask));
int image_ascent P_ ((struct image *, struct face *, struct glyph_slice *));
#endif
/* Defined in sysdep.c */
@ -2733,7 +2777,7 @@ extern int required_matrix_height P_ ((struct window *));
extern Lisp_Object buffer_posn_from_coords P_ ((struct window *,
int *, int *,
struct display_pos *,
Lisp_Object *,
Lisp_Object *,
int *, int *, int *, int *));
extern Lisp_Object mode_line_string P_ ((struct window *, enum window_part,
int *, int *, int *,

24
src/dispnew.c
View file

@ -5740,6 +5740,9 @@ buffer_posn_from_coords (w, x, y, pos, object, dx, dy, width, height)
struct text_pos startp;
Lisp_Object string;
struct glyph_row *row;
#ifdef HAVE_WINDOW_SYSTEM
struct image *img = 0;
#endif
int x0, x1;
current_buffer = XBUFFER (w->buffer);
@ -5765,7 +5768,6 @@ buffer_posn_from_coords (w, x, y, pos, object, dx, dy, width, height)
#ifdef HAVE_WINDOW_SYSTEM
if (it.what == IT_IMAGE)
{
struct image *img;
if ((img = IMAGE_FROM_ID (it.f, it.image_id)) != NULL
&& !NILP (img->spec))
*object = img->spec;
@ -5778,12 +5780,22 @@ buffer_posn_from_coords (w, x, y, pos, object, dx, dy, width, height)
if (it.hpos < row->used[TEXT_AREA])
{
struct glyph *glyph = row->glyphs[TEXT_AREA] + it.hpos;
*width = glyph->pixel_width;
*height = glyph->ascent + glyph->descent;
#ifdef HAVE_WINDOW_SYSTEM
if (glyph->type == IMAGE_GLYPH)
*dy -= row->ascent - glyph->ascent;
if (img)
{
*dy -= row->ascent - glyph->ascent;
*dx += glyph->slice.x;
*dy += glyph->slice.y;
/* Image slices positions are still relative to the entire image */
*width = img->width;
*height = img->height;
}
else
#endif
{
*width = glyph->pixel_width;
*height = glyph->ascent + glyph->descent;
}
}
else
{
@ -5949,6 +5961,8 @@ marginal_area_string (w, part, x, y, charpos, object, dx, dy, width, height)
if (img != NULL)
*object = img->spec;
y0 -= row->ascent - glyph->ascent;
x0 += glyph->slice.x;
y0 += glyph->slice.y;
}
#endif
}

15
src/fns.c
View file

@ -1560,7 +1560,7 @@ assq_no_quit (key, list)
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
The value is actually the first element of LIST whose car equals KEY. */)
(key, list)
(key, list)
Lisp_Object key, list;
{
Lisp_Object result, car;
@ -2135,6 +2135,18 @@ The PLIST is modified by side effects. */)
return plist;
}
DEFUN ("eql", Feql, Seql, 2, 2, 0,
doc: /* Return t if the two args are the same Lisp object.
Floating-point numbers of equal value are `eql', but they may not be `eq'. */)
(obj1, obj2)
Lisp_Object obj1, obj2;
{
if (FLOATP (obj1))
return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil;
else
return EQ (obj1, obj2) ? Qt : Qnil;
}
DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
doc: /* Return t if two Lisp objects have similar structure and contents.
They must have the same data type.
@ -5740,6 +5752,7 @@ used if both `use-dialog-box' and this variable are non-nil. */);
defsubr (&Sput);
defsubr (&Slax_plist_get);
defsubr (&Slax_plist_put);
defsubr (&Seql);
defsubr (&Sequal);
defsubr (&Sequal_including_properties);
defsubr (&Sfillarray);

59
src/fontset.c
View file

@ -195,7 +195,7 @@ static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static int fontset_id_valid_p P_ ((int));
static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
static Lisp_Object regulalize_fontname P_ ((Lisp_Object));
static Lisp_Object regularize_fontname P_ ((Lisp_Object));
/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
@ -1043,7 +1043,7 @@ check_fontset_name (name)
string, maybe change FONTNAME to (FAMILY . REGISTRY). */
static Lisp_Object
regulalize_fontname (Lisp_Object fontname)
regularize_fontname (Lisp_Object fontname)
{
Lisp_Object family, registry;
@ -1133,7 +1133,7 @@ name of a font, REGISTRY is a registry name of a font. */)
if (!NILP (frame))
CHECK_LIVE_FRAME (frame);
elt = Fcons (make_number (from), regulalize_fontname (fontname));
elt = Fcons (make_number (from), regularize_fontname (fontname));
for (; from <= to; from++)
FONTSET_SET (fontset, from, elt);
Foptimize_char_table (fontset);
@ -1212,7 +1212,10 @@ If the named font is not yet loaded, return nil. */)
/* Return a cons (FONT-NAME . GLYPH-CODE).
FONT-NAME is the font name for the character at POSITION in the current
buffer. This is computed from all the text properties and overlays
that apply to POSITION.
that apply to POSITION. POSTION may be nil, in which case,
FONT-NAME is the font name for display the character CH with the
default face.
GLYPH-CODE is the glyph code in the font to use for the character.
If the 2nd optional arg CH is non-nil, it is a character to check
@ -1225,7 +1228,8 @@ If the named font is not yet loaded, return nil. */)
(2) The character code is invalid.
(3) The current buffer is not displayed in any window.
(3) If POSITION is not nil, and the current buffer is not displayed
in any window.
In addition, the returned font name may not take into account of
such redisplay engine hooks as what used in jit-lock-mode if
@ -1240,31 +1244,42 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
int pos, pos_byte, dummy;
int face_id;
int c, code;
Lisp_Object window;
struct window *w;
struct frame *f;
struct face *face;
CHECK_NUMBER_COERCE_MARKER (position);
pos = XINT (position);
if (pos < BEGV || pos >= ZV)
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
pos_byte = CHAR_TO_BYTE (pos);
if (NILP (ch))
c = FETCH_CHAR (pos_byte);
else
if (NILP (position))
{
CHECK_NATNUM (ch);
c = XINT (ch);
f = XFRAME (selected_frame);
face_id = DEFAULT_FACE_ID;
}
else
{
Lisp_Object window;
struct window *w;
CHECK_NUMBER_COERCE_MARKER (position);
pos = XINT (position);
if (pos < BEGV || pos >= ZV)
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
pos_byte = CHAR_TO_BYTE (pos);
if (NILP (ch))
c = FETCH_CHAR (pos_byte);
else
{
CHECK_NATNUM (ch);
c = XINT (ch);
}
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
return Qnil;
w = XWINDOW (window);
f = XFRAME (w->frame);
face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
}
if (! CHAR_VALID_P (c, 0))
return Qnil;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
return Qnil;
w = XWINDOW (window);
f = XFRAME (w->frame);
face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
face = FACE_FROM_ID (f, face_id);
if (! face->font || ! face->font_name)
@ -1540,7 +1555,7 @@ It is intended that this function is called only from
elt = XCAR (tail);
target = Fcar (elt);
elt = Fcons (Qnil, regulalize_fontname (Fcdr (elt)));
elt = Fcons (Qnil, regularize_fontname (Fcdr (elt)));
if (! CHAR_TABLE_P (target))
{
int charset, c;

12
src/image.c
View file

@ -1076,13 +1076,21 @@ prepare_image_for_display (f, img)
drawn in face FACE. */
int
image_ascent (img, face)
image_ascent (img, face, slice)
struct image *img;
struct face *face;
struct glyph_slice *slice;
{
int height = img->height + img->vmargin;
int height;
int ascent;
if (slice->height == img->height)
height = img->height + img->vmargin;
else if (slice->y == 0)
height = slice->height + img->vmargin;
else
height = slice->height;
if (img->ascent == CENTERED_IMAGE_ASCENT)
{
if (face->font)

57
src/keyboard.c
View file

@ -10618,6 +10618,61 @@ The elements of this list correspond to the arguments of
return Flist (sizeof (val) / sizeof (val[0]), val);
}
DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 3, 0,
doc: /* Return position information for pixel coordinates X and Y.
By default, X and Y are relative to text area of the selected window.
Optional third arg FRAME_OR_WINDOW non-nil specifies frame or window.
The return value is similar to a mouse click position:
(WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
IMAGE (DX . DY) (WIDTH . HEIGHT))
The `posn-' functions access elements of such lists. */)
(x, y, frame_or_window)
Lisp_Object x, y, frame_or_window;
{
if (NILP (frame_or_window))
frame_or_window = selected_window;
if (WINDOWP (frame_or_window))
{
struct window *w;
CHECK_LIVE_WINDOW (frame_or_window);
w = XWINDOW (frame_or_window);
XSETINT (x, (WINDOW_TO_FRAME_PIXEL_X (w, XINT (x))
+ window_box_left_offset (w, TEXT_AREA)));
XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
frame_or_window = w->frame;
}
CHECK_LIVE_FRAME (frame_or_window);
return make_lispy_position (XFRAME (frame_or_window), &x, &y, 0);
}
DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
doc: /* Return position information for buffer POS in WINDOW.
POS defaults to point in WINDOW; WINDOW defaults to the selected window.
Return nil if position is not visible in window. Otherwise,
the return value is similar to that returned by event-start for
a mouse click at the upper left corner of the glyph corresponding
to the given buffer position:
(WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
IMAGE (DX . DY) (WIDTH . HEIGHT))
The `posn-' functions access elements of such lists. */*/)
(pos, window)
Lisp_Object pos, window;
{
Lisp_Object tem;
tem = Fpos_visible_in_window_p (pos, window, Qt);
if (!NILP (tem))
tem = Fposn_at_x_y (XCAR (tem), XCAR (XCDR (tem)), window);
return tem;
}
/*
* Set up a new kboard object with reasonable initial values.
@ -11047,6 +11102,8 @@ syms_of_keyboard ()
defsubr (&Sset_input_mode);
defsubr (&Scurrent_input_mode);
defsubr (&Sexecute_extended_command);
defsubr (&Sposn_at_point);
defsubr (&Sposn_at_x_y);
DEFVAR_LISP ("last-command-char", &last_command_char,
doc: /* Last input event that was part of a command. */);

6
src/keymap.c
View file

@ -1959,14 +1959,14 @@ spaces are put between sequence elements, etc. */)
int len = 0;
int i, i_byte;
Lisp_Object *args;
int size = Flength (keys);
int size = XINT (Flength (keys));
Lisp_Object list;
Lisp_Object sep = build_string (" ");
Lisp_Object key;
int add_meta = 0;
if (!NILP (prefix))
size += Flength (prefix);
size += XINT (Flength (prefix));
/* This has one extra element at the end that we don't pass to Fconcat. */
args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
@ -1997,7 +1997,7 @@ spaces are put between sequence elements, etc. */)
else if (VECTORP (list))
size = XVECTOR (list)->size;
else if (CONSP (list))
size = Flength (list);
size = XINT (Flength (list));
else
wrong_type_argument (Qarrayp, list);

7
src/lisp.h
View file

@ -382,7 +382,7 @@ enum pvec_type
#ifdef EXPLICIT_SIGN_EXTEND
/* Make sure we sign-extend; compilers have been known to fail to do so. */
#define XINT(a) (((a).i << (BITS_PER_EMACS_INT - VALBITS)) \
#define XINT(a) (((a).s.val << (BITS_PER_EMACS_INT - VALBITS)) \
>> (BITS_PER_EMACS_INT - VALBITS))
#else
#define XINT(a) ((a).s.val)
@ -400,7 +400,7 @@ enum pvec_type
extern Lisp_Object make_number ();
#endif
#define EQ(x, y) ((x).s.val == (y).s.val)
#define EQ(x, y) ((x).s.val == (y).s.val && (x).s.type == (y).s.type)
#endif /* NO_UNION_TYPE */
@ -2391,7 +2391,8 @@ void set_frame_cursor_types P_ ((struct frame *, Lisp_Object));
extern void syms_of_xdisp P_ ((void));
extern void init_xdisp P_ ((void));
extern Lisp_Object safe_eval P_ ((Lisp_Object));
extern int pos_visible_p P_ ((struct window *, int, int *, int));
extern int pos_visible_p P_ ((struct window *, int, int *,
int *, int *, int));
/* Defined in vm-limit.c. */
extern void memory_warnings P_ ((POINTER_TYPE *, void (*warnfun) ()));

174
src/macterm.c
View file

@ -294,7 +294,6 @@ void deactivate_scroll_bars (FRAME_PTR);
static int is_emacs_window (WindowPtr);
extern int image_ascent (struct image *, struct face *);
int x_bitmap_icon (struct frame *, Lisp_Object);
void x_make_frame_visible (struct frame *);
@ -311,7 +310,7 @@ XFreePixmap (display, pixmap)
Display *display; /* not used */
Pixmap pixmap;
{
DisposeGWorld (pixmap);
DisposeGWorld (pixmap);
}
@ -1283,7 +1282,7 @@ mac_draw_vertical_window_border (w, x, y0, y1)
int x, y0, y1;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
XDrawLine (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f),
f->output_data.mac->normal_gc, x, y0, x, y1);
}
@ -1525,7 +1524,7 @@ x_draw_fringe_bitmap (w, row, p)
: face->foreground);
gcv.background = face->background;
mac_draw_bitmap (display, window, &gcv, p->x, p->y,
mac_draw_bitmap (display, window, &gcv, p->x, p->y,
p->wd, p->h, bits, p->overlay_p);
}
@ -1759,7 +1758,8 @@ static void x_draw_image_foreground_1 P_ ((struct glyph_string *, Pixmap));
static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
int, int, int));
static void x_draw_relief_rect P_ ((struct frame *, int, int, int, int,
int, int, int, int, Rect *));
int, int, int, int, int, int,
Rect *));
static void x_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
int, int, int, Rect *));
@ -2483,9 +2483,10 @@ x_setup_relief_colors (s)
static void
x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
raised_p, left_p, right_p, clip_rect)
raised_p, top_p, bot_p, left_p, right_p, clip_rect)
struct frame *f;
int left_x, top_y, right_x, bottom_y, width, left_p, right_p, raised_p;
int left_x, top_y, right_x, bottom_y, width;
int top_p, bot_p, left_p, right_p, raised_p;
Rect *clip_rect;
{
Display *dpy = FRAME_MAC_DISPLAY (f);
@ -2500,10 +2501,11 @@ x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
mac_set_clip_rectangle (dpy, window, clip_rect);
/* Top. */
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, top_y + i,
right_x - i * right_p, top_y + i);
if (top_p)
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, top_y + i,
right_x - i * right_p, top_y + i);
/* Left. */
if (left_p)
@ -2520,10 +2522,11 @@ x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
clip_rect);
/* Bottom. */
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, bottom_y - i,
right_x - i * right_p, bottom_y - i);
if (bot_p)
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, bottom_y - i,
right_x - i * right_p, bottom_y - i);
/* Right. */
if (right_p)
@ -2629,7 +2632,7 @@ x_draw_glyph_string_box (s)
{
x_setup_relief_colors (s);
x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
width, raised_p, left_p, right_p, &clip_rect);
width, raised_p, 1, 1, left_p, right_p, &clip_rect);
}
}
@ -2640,21 +2643,22 @@ static void
x_draw_image_foreground (s)
struct glyph_string *s;
{
int x;
int y = s->ybase - image_ascent (s->img, s->face);
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
x = s->x;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->img->pixmap)
{
@ -2667,11 +2671,12 @@ x_draw_image_foreground (s)
CONVERT_TO_XRECT (clip_rect, nr);
image_rect.x = x;
image_rect.y = y;
image_rect.width = s->img->width;
image_rect.height = s->img->height;
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
mac_copy_area_with_mask (s->display, s->img->pixmap, s->img->mask,
s->window, s->gc, r.x - x, r.y - y,
s->window, s->gc,
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.width, r.height, r.x, r.y);
}
else
@ -2683,11 +2688,12 @@ x_draw_image_foreground (s)
CONVERT_TO_XRECT (clip_rect, nr);
image_rect.x = x;
image_rect.y = y;
image_rect.width = s->img->width;
image_rect.height = s->img->height;
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
mac_copy_area (s->display, s->img->pixmap, s->window, s->gc,
r.x - x, r.y - y, r.width, r.height, r.x, r.y);
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.width, r.height, r.x, r.y);
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
@ -2699,15 +2705,17 @@ x_draw_image_foreground (s)
{
int r = s->img->relief;
if (r < 0) r = -r;
mac_draw_rectangle (s->display, s->window, s->gc, x - r, y - r,
s->img->width + r*2 - 1, s->img->height + r*2 - 1);
mac_draw_rectangle (s->display, s->window, s->gc,
x - r, y - r,
s->slice.width + r*2 - 1,
s->slice.height + r*2 - 1);
}
}
}
else
/* Draw a rectangle if image could not be loaded. */
mac_draw_rectangle (s->display, s->window, s->gc, x, y,
s->img->width - 1, s->img->height - 1);
s->slice.width - 1, s->slice.height - 1);
}
@ -2719,21 +2727,22 @@ x_draw_image_relief (s)
{
int x0, y0, x1, y1, thick, raised_p;
Rect r;
int x;
int y = s->ybase - image_ascent (s->img, s->face);
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
x = s->x;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
@ -2749,12 +2758,17 @@ x_draw_image_relief (s)
x0 = x - thick;
y0 = y - thick;
x1 = x + s->img->width + thick - 1;
y1 = y + s->img->height + thick - 1;
x1 = x + s->slice.width + thick - 1;
y1 = y + s->slice.height + thick - 1;
x_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
x_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
x_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p,
s->slice.y == 0,
s->slice.y + s->slice.height == s->img->height,
s->slice.x == 0,
s->slice.x + s->slice.width == s->img->width,
&r);
}
@ -2765,33 +2779,37 @@ x_draw_image_foreground_1 (s, pixmap)
struct glyph_string *s;
Pixmap pixmap;
{
int x;
int y = s->ybase - s->y - image_ascent (s->img, s->face);
int x = 0;
int y = s->ybase - s->y - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = abs (s->face->box_line_width);
else
x = 0;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->img->pixmap)
{
if (s->img->mask)
mac_copy_area_with_mask_to_pixmap (s->display, s->img->pixmap,
s->img->mask, pixmap, s->gc,
0, 0, s->img->width, s->img->height,
s->slice.x, s->slice.y,
s->slice.width, s->slice.height,
x, y);
else
{
mac_copy_area_to_pixmap (s->display, s->img->pixmap, pixmap, s->gc,
0, 0, s->img->width, s->img->height, x, y);
s->slice.x, s->slice.y,
s->slice.width, s->slice.height,
x, y);
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
@ -2804,15 +2822,15 @@ x_draw_image_foreground_1 (s, pixmap)
int r = s->img->relief;
if (r < 0) r = -r;
mac_draw_rectangle (s->display, s->window, s->gc, x - r, y - r,
s->img->width + r*2 - 1,
s->img->height + r*2 - 1);
s->slice.width + r*2 - 1,
s->slice.height + r*2 - 1);
}
}
}
else
/* Draw a rectangle if image could not be loaded. */
mac_draw_rectangle_to_pixmap (s->display, pixmap, s->gc, x, y,
s->img->width - 1, s->img->height - 1);
s->slice.width - 1, s->slice.height - 1);
}
@ -2869,19 +2887,21 @@ x_draw_image_glyph_string (s)
taller than image or if image has a clip mask to reduce
flickering. */
s->stippled_p = s->face->stipple != 0;
if (height > s->img->height
if (height > s->slice.height
|| s->img->hmargin
|| s->img->vmargin
|| s->img->mask
|| s->img->pixmap == 0
|| s->width != s->background_width)
{
if (box_line_hwidth && s->first_glyph->left_box_line_p)
x = s->x + box_line_hwidth;
else
x = s->x;
x = s->x;
if (s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += box_line_hwidth;
y = s->y + box_line_vwidth;
y = s->y;
if (s->slice.y == 0)
y += box_line_vwidth;
if (s->img->mask)
{
@ -3842,7 +3862,7 @@ glyph_rect (f, x, y, rect)
/* x is to the right of the last glyph in the row. */
rect->left = WINDOW_TO_FRAME_PIXEL_X (w, gx);
/* Shouldn't this be a pixel value?
/* Shouldn't this be a pixel value?
WINDOW_RIGHT_EDGE_X (w) seems to be the right value.
++KFS */
rect->right = WINDOW_RIGHT_EDGE_COL (w);
@ -3984,7 +4004,7 @@ mac_handle_tool_bar_click (f, button_event)
if (button_event->what == mouseDown)
handle_tool_bar_click (f, x, y, 1, 0);
else
handle_tool_bar_click (f, x, y, 0,
handle_tool_bar_click (f, x, y, 0,
x_mac_to_emacs_modifiers (FRAME_MAC_DISPLAY_INFO (f),
button_event->modifiers));
}
@ -4933,7 +4953,7 @@ x_new_font (f, fontname)
if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0)
{
int wid = FRAME_COLUMN_WIDTH (f);
FRAME_CONFIG_SCROLL_BAR_COLS (f)
FRAME_CONFIG_SCROLL_BAR_COLS (f)
= (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid-1) / wid;
}
else
@ -5826,7 +5846,7 @@ decode_mac_font_name (char *name, int size, short scriptcode)
break;
case smKorean:
coding_system = Qeuc_kr;
break;
break;
default:
return;
}
@ -6277,7 +6297,7 @@ mac_do_list_fonts (pattern, maxnames)
if (fast_string_match (pattern_regex, fontname) >= 0)
{
font_list = Fcons (fontname, font_list);
n_fonts++;
if (maxnames > 0 && n_fonts >= maxnames)
break;
@ -6987,7 +7007,7 @@ mac_get_emulated_btn ( UInt32 modifiers )
if (modifiers & controlKey)
result = cmdIs3 ? 2 : 1;
else if (modifiers & optionKey)
result = cmdIs3 ? 1 : 2;
result = cmdIs3 ? 1 : 2;
}
return result;
}
@ -7020,7 +7040,7 @@ mac_get_mouse_btn (EventRef ref)
switch (result)
{
case kEventMouseButtonPrimary:
if (Vmac_emulate_three_button_mouse == Qnil)
if (Vmac_emulate_three_button_mouse == Qnil)
return 0;
else {
UInt32 mods = 0;
@ -8189,7 +8209,7 @@ XTread_socket (int sd, int expected, struct input_event *hold_quit)
switch (part_code)
{
case inMenuBar:
if (er.what == mouseDown)
if (er.what == mouseDown)
{
struct frame *f = ((mac_output *)
GetWRefCon (FrontWindow ()))->mFP;
@ -8269,7 +8289,7 @@ XTread_socket (int sd, int expected, struct input_event *hold_quit)
else
mouse_tracking_in_progress = mouse_tracking_none;
window = window_from_coordinates (mwp->mFP, inev.x, inev.y, 0, 0, 0, 1);
if (EQ (window, mwp->mFP->tool_bar_window))
{
if (er.what == mouseDown)
@ -8308,10 +8328,10 @@ XTread_socket (int sd, int expected, struct input_event *hold_quit)
case inDrag:
#if TARGET_API_MAC_CARBON
if (er.what == mouseDown)
if (er.what == mouseDown)
{
BitMap bm;
GetQDGlobalsScreenBits (&bm);
DragWindow (window_ptr, er.where, &bm.bounds);
}
@ -8331,7 +8351,7 @@ XTread_socket (int sd, int expected, struct input_event *hold_quit)
/* window resize handling added --ben */
case inGrow:
if (er.what == mouseDown)
if (er.what == mouseDown)
{
do_grow_window(window_ptr, &er);
break;
@ -9186,10 +9206,10 @@ Otherwise the option key is used. */);
useful for non-standard keyboard layouts. */);
Vmac_reverse_ctrl_meta = Qnil;
DEFVAR_LISP ("mac-emulate-three-button-mouse",
DEFVAR_LISP ("mac-emulate-three-button-mouse",
&Vmac_emulate_three_button_mouse,
doc: /* t means that when the option-key is held down while pressing the
mouse button, the click will register as mouse-2 and while the
mouse button, the click will register as mouse-2 and while the
command-key is held down, the click will register as mouse-3.
'reverse means that the the option-key will register for mouse-3
and the command-key will register for mouse-2. nil means that

2
src/makefile.w32-in
View file

@ -1,4 +1,4 @@
# Makefile for GNU Emacs on the Microsoft W32 API.
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (c) 2000-2001 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.

153
src/w32term.c
View file

@ -1220,7 +1220,8 @@ static void w32_draw_image_foreground_1 P_ ((struct glyph_string *, HBITMAP));
static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
int, int, int));
static void w32_draw_relief_rect P_ ((struct frame *, int, int, int, int,
int, int, int, int, RECT *));
int, int, int, int, int, int,
RECT *));
static void w32_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
int, int, int, RECT *));
@ -1801,9 +1802,10 @@ x_setup_relief_colors (s)
static void
w32_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
raised_p, left_p, right_p, clip_rect)
raised_p, top_p, bot_p, left_p, right_p, clip_rect)
struct frame *f;
int left_x, top_y, right_x, bottom_y, width, left_p, right_p, raised_p;
int left_x, top_y, right_x, bottom_y, width;
int top_p, bot_p, left_p, right_p, raised_p;
RECT *clip_rect;
{
int i;
@ -1818,10 +1820,11 @@ w32_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
w32_set_clip_rectangle (hdc, clip_rect);
/* Top. */
for (i = 0; i < width; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, top_y + i,
right_x - left_x - i * (left_p + right_p ) + 1, 1);
if (top_p)
for (i = 0; i < width; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, top_y + i,
right_x - left_x - i * (left_p + right_p ) + 1, 1);
/* Left. */
if (left_p)
@ -1836,10 +1839,11 @@ w32_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
gc.foreground = f->output_data.w32->white_relief.gc->foreground;
/* Bottom. */
for (i = 0; i < width; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, bottom_y - i,
right_x - left_x - i * (left_p + right_p) + 1, 1);
if (bot_p)
for (i = 0; i < width; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, bottom_y - i,
right_x - left_x - i * (left_p + right_p) + 1, 1);
/* Right. */
if (right_p)
@ -1949,7 +1953,7 @@ x_draw_glyph_string_box (s)
{
x_setup_relief_colors (s);
w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
width, raised_p, left_p, right_p, &clip_rect);
width, raised_p, 1, 1, left_p, right_p, &clip_rect);
}
}
@ -1960,21 +1964,22 @@ static void
x_draw_image_foreground (s)
struct glyph_string *s;
{
int x;
int y = s->ybase - image_ascent (s->img, s->face);
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
x = s->x;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
SaveDC (s->hdc);
@ -1996,12 +2001,12 @@ x_draw_image_foreground (s)
SetTextColor (s->hdc, RGB (255, 255, 255));
SetBkColor (s->hdc, RGB (0, 0, 0));
BitBlt (s->hdc, x, y, s->img->width, s->img->height,
compat_hdc, 0, 0, SRCINVERT);
BitBlt (s->hdc, x, y, s->img->width, s->img->height,
mask_dc, 0, 0, SRCAND);
BitBlt (s->hdc, x, y, s->img->width, s->img->height,
compat_hdc, 0, 0, SRCINVERT);
BitBlt (s->hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCINVERT);
BitBlt (s->hdc, x, y, s->slice.width, s->slice.height,
mask_dc, s->slice.x, s->slice.y, SRCAND);
BitBlt (s->hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCINVERT);
SelectObject (mask_dc, mask_orig_obj);
DeleteDC (mask_dc);
@ -2011,8 +2016,8 @@ x_draw_image_foreground (s)
SetTextColor (s->hdc, s->gc->foreground);
SetBkColor (s->hdc, s->gc->background);
BitBlt (s->hdc, x, y, s->img->width, s->img->height,
compat_hdc, 0, 0, SRCCOPY);
BitBlt (s->hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCCOPY);
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
@ -2025,7 +2030,8 @@ x_draw_image_foreground (s)
int r = s->img->relief;
if (r < 0) r = -r;
w32_draw_rectangle (s->hdc, s->gc, x - r, y - r ,
s->img->width + r*2 - 1, s->img->height + r*2 - 1);
s->slice.width + r*2 - 1,
s->slice.height + r*2 - 1);
}
}
@ -2036,8 +2042,8 @@ x_draw_image_foreground (s)
DeleteDC (compat_hdc);
}
else
w32_draw_rectangle (s->hdc, s->gc, x, y, s->img->width -1,
s->img->height - 1);
w32_draw_rectangle (s->hdc, s->gc, x, y,
s->slice.width - 1, s->slice.height - 1);
RestoreDC (s->hdc ,-1);
}
@ -2052,21 +2058,22 @@ x_draw_image_relief (s)
{
int x0, y0, x1, y1, thick, raised_p;
RECT r;
int x;
int y = s->ybase - image_ascent (s->img, s->face);
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
x = s->x;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
@ -2082,12 +2089,17 @@ x_draw_image_relief (s)
x0 = x - thick;
y0 = y - thick;
x1 = x + s->img->width + thick - 1;
y1 = y + s->img->height + thick - 1;
x1 = x + s->slice.width + thick - 1;
y1 = y + s->slice.height + thick - 1;
x_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
w32_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
w32_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p,
s->slice.y == 0,
s->slice.y + s->slice.height == s->img->height,
s->slice.x == 0,
s->slice.x + s->slice.width == s->img->width,
&r);
}
@ -2100,21 +2112,22 @@ w32_draw_image_foreground_1 (s, pixmap)
{
HDC hdc = CreateCompatibleDC (s->hdc);
HGDIOBJ orig_hdc_obj = SelectObject (hdc, pixmap);
int x;
int y = s->ybase - s->y - image_ascent (s->img, s->face);
int x = 0;
int y = s->ybase - s->y - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = abs (s->face->box_line_width);
else
x = 0;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->img->pixmap)
{
@ -2130,12 +2143,12 @@ w32_draw_image_foreground_1 (s, pixmap)
SetTextColor (hdc, RGB (0, 0, 0));
SetBkColor (hdc, RGB (255, 255, 255));
BitBlt (hdc, x, y, s->img->width, s->img->height,
compat_hdc, 0, 0, SRCINVERT);
BitBlt (hdc, x, y, s->img->width, s->img->height,
mask_dc, 0, 0, SRCAND);
BitBlt (hdc, x, y, s->img->width, s->img->height,
compat_hdc, 0, 0, SRCINVERT);
BitBlt (hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCINVERT);
BitBlt (hdc, x, y, s->slice.width, s->slice.height,
mask_dc, s->slice.x, s->slice.y, SRCAND);
BitBlt (hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCINVERT);
SelectObject (mask_dc, mask_orig_obj);
DeleteDC (mask_dc);
@ -2145,8 +2158,8 @@ w32_draw_image_foreground_1 (s, pixmap)
SetTextColor (hdc, s->gc->foreground);
SetBkColor (hdc, s->gc->background);
BitBlt (hdc, x, y, s->img->width, s->img->height,
compat_hdc, 0, 0, SRCCOPY);
BitBlt (hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCCOPY);
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
@ -2158,8 +2171,9 @@ w32_draw_image_foreground_1 (s, pixmap)
{
int r = s->img->relief;
if (r < 0) r = -r;
w32_draw_rectangle (hdc, s->gc, x - r, y - r ,
s->img->width + r*2 - 1, s->img->height + r*2 - 1);
w32_draw_rectangle (hdc, s->gc, x - r, y - r,
s->slice.width + r*2 - 1,
s->slice.height + r*2 - 1);
}
}
@ -2169,8 +2183,8 @@ w32_draw_image_foreground_1 (s, pixmap)
DeleteDC (compat_hdc);
}
else
w32_draw_rectangle (hdc, s->gc, x, y, s->img->width - 1,
s->img->height - 1);
w32_draw_rectangle (hdc, s->gc, x, y,
s->slice.width - 1, s->slice.height - 1);
SelectObject (hdc, orig_hdc_obj);
DeleteDC (hdc);
@ -2229,19 +2243,22 @@ x_draw_image_glyph_string (s)
taller than image or if image has a clip mask to reduce
flickering. */
s->stippled_p = s->face->stipple != 0;
if (height > s->img->height
if (height > s->slice.height
|| s->img->hmargin
|| s->img->vmargin
|| s->img->mask
|| s->img->pixmap == 0
|| s->width != s->background_width)
{
if (box_line_hwidth && s->first_glyph->left_box_line_p)
x = s->x + box_line_hwidth;
else
x = s->x;
x = s->x;
if (s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += box_line_hwidth;
y = s->y;
if (s->slice.y == 0)
y += box_line_vwidth;
y = s->y + box_line_vwidth;
#if 0 /* TODO: figure out if we need to do this on Windows. */
if (s->img->mask)
{

1
src/w32term.h
View file

@ -719,7 +719,6 @@ XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
struct frame * check_x_frame (Lisp_Object);
EXFUN (Fx_display_color_p, 1);
EXFUN (Fx_display_grayscale_p, 1);
int image_ascent P_ ((struct image *, struct face *));
#define FONT_TYPE_FOR_UNIBYTE(font, ch) \
((font)->bdf ? BDF_1D_FONT : ANSI_FONT)

93
src/window.c
View file

@ -324,7 +324,11 @@ DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p,
Return nil if that position is scrolled vertically out of view.
If a character is only partially visible, nil is returned, unless the
optional argument PARTIALLY is non-nil.
POS defaults to point in WINDOW; WINDOW defaults to the selected window. */)
POS defaults to point in WINDOW; WINDOW defaults to the selected window.
If POS is visible, return t if PARTIALLY is nil; if PARTIALLY is non-nil,
return value is a list (X Y PARTIAL) where X and Y are the pixel relative
coordinate */)
(pos, window, partially)
Lisp_Object pos, window, partially;
{
@ -332,8 +336,9 @@ POS defaults to point in WINDOW; WINDOW defaults to the selected window. */)
register int posint;
register struct buffer *buf;
struct text_pos top;
Lisp_Object in_window;
int fully_p;
Lisp_Object in_window = Qnil;
int fully_p = 1;
int x, y;
w = decode_window (window);
buf = XBUFFER (w->buffer);
@ -349,38 +354,20 @@ POS defaults to point in WINDOW; WINDOW defaults to the selected window. */)
else
posint = XMARKER (w->pointm)->charpos;
/* If position is above window start, it's not visible. */
if (posint < CHARPOS (top))
in_window = Qnil;
else if (XFASTINT (w->last_modified) >= BUF_MODIFF (buf)
&& XFASTINT (w->last_overlay_modified) >= BUF_OVERLAY_MODIFF (buf)
&& posint < BUF_Z (buf) - XFASTINT (w->window_end_pos))
{
/* If frame is up-to-date, and POSINT is < window end pos, use
that info. This doesn't work for POSINT == end pos, because
the window end pos is actually the position _after_ the last
char in the window. */
if (NILP (partially))
{
pos_visible_p (w, posint, &fully_p, NILP (partially));
in_window = fully_p ? Qt : Qnil;
}
else
in_window = Qt;
}
else if (posint > BUF_ZV (buf))
in_window = Qnil;
else if (CHARPOS (top) < BUF_BEGV (buf) || CHARPOS (top) > BUF_ZV (buf))
/* If window start is out of range, do something reasonable. */
in_window = Qnil;
else
{
if (pos_visible_p (w, posint, &fully_p, NILP (partially)))
in_window = !NILP (partially) || fully_p ? Qt : Qnil;
else
in_window = Qnil;
}
/* If position is above window start or outside buffer boundaries,
or if window start is out of range, position is not visible. */
if (posint >= CHARPOS (top)
&& posint <= BUF_ZV (buf)
&& CHARPOS (top) >= BUF_BEGV (buf)
&& CHARPOS (top) <= BUF_ZV (buf)
&& pos_visible_p (w, posint, &fully_p, &x, &y, NILP (partially))
&& (!NILP (partially) || fully_p))
in_window = Qt;
if (!NILP (in_window) && !NILP (partially))
in_window = Fcons (make_number (x),
Fcons (make_number (y),
Fcons (fully_p ? Qt : Qnil, Qnil)));
return in_window;
}
@ -3462,7 +3449,7 @@ DEFUN ("force-window-update", Fforce_window_update, Sforce_window_update,
0, 1, 0,
doc: /* Force redisplay of all windows.
If optional arg OBJECT is a window, force redisplay of that window only.
If OBJECT is a buffer or buffer name, force redisplay of all windows
If OBJECT is a buffer or buffer name, force redisplay of all windows
displaying that buffer. */)
(object)
Lisp_Object object;
@ -3484,7 +3471,7 @@ displaying that buffer. */)
++update_mode_lines;
return Qt;
}
if (STRINGP (object))
object = Fget_buffer (object);
if (BUFFERP (object) && !NILP (XBUFFER (object)->name))
@ -3549,7 +3536,7 @@ temp_output_buffer_show (buf)
Lisp_Object prev_window, prev_buffer;
prev_window = selected_window;
XSETBUFFER (prev_buffer, old);
/* Select the window that was chosen, for running the hook.
Note: Both Fselect_window and select_window_norecord may
set-buffer to the buffer displayed in the window,
@ -6069,7 +6056,7 @@ If TYPE is t, use the frame's scroll-bar type. */)
vertical_type = Qnil;
if (!(EQ (vertical_type, Qnil)
|| EQ (vertical_type, Qleft)
|| EQ (vertical_type, Qleft)
|| EQ (vertical_type, Qright)
|| EQ (vertical_type, Qt)))
error ("Invalid type of vertical scroll bar");
@ -6118,12 +6105,13 @@ value. */)
Smooth scrolling
***********************************************************************/
DEFUN ("window-vscroll", Fwindow_vscroll, Swindow_vscroll, 0, 1, 0,
DEFUN ("window-vscroll", Fwindow_vscroll, Swindow_vscroll, 0, 2, 0,
doc: /* Return the amount by which WINDOW is scrolled vertically.
Use the selected window if WINDOW is nil or omitted.
Value is a multiple of the canonical character height of WINDOW. */)
(window)
Lisp_Object window;
Normally, value is a multiple of the canonical character height of WINDOW;
optional second arg PIXELS_P means value is measured in pixels. */)
(window, pixels_p)
Lisp_Object window, pixels_p;
{
Lisp_Object result;
struct frame *f;
@ -6137,7 +6125,9 @@ Value is a multiple of the canonical character height of WINDOW. */)
f = XFRAME (w->frame);
if (FRAME_WINDOW_P (f))
result = FRAME_CANON_Y_FROM_PIXEL_Y (f, -w->vscroll);
result = (NILP (pixels_p)
? FRAME_CANON_Y_FROM_PIXEL_Y (f, -w->vscroll)
: make_number (-w->vscroll));
else
result = make_number (0);
return result;
@ -6145,12 +6135,13 @@ Value is a multiple of the canonical character height of WINDOW. */)
DEFUN ("set-window-vscroll", Fset_window_vscroll, Sset_window_vscroll,
2, 2, 0,
2, 3, 0,
doc: /* Set amount by which WINDOW should be scrolled vertically to VSCROLL.
WINDOW nil means use the selected window. VSCROLL is a non-negative
multiple of the canonical character height of WINDOW. */)
(window, vscroll)
Lisp_Object window, vscroll;
WINDOW nil means use the selected window. Normally, VSCROLL is a
non-negative multiple of the canonical character height of WINDOW;
optional third arg PIXELS_P non-nil means that VSCROLL is in pixels. */)
(window, vscroll, pixels_p)
Lisp_Object window, vscroll, pixels_p;
{
struct window *w;
struct frame *f;
@ -6168,7 +6159,9 @@ multiple of the canonical character height of WINDOW. */)
{
int old_dy = w->vscroll;
w->vscroll = - FRAME_LINE_HEIGHT (f) * XFLOATINT (vscroll);
w->vscroll = - (NILP (pixels_p)
? FRAME_LINE_HEIGHT (f) * XFLOATINT (vscroll)
: XFLOATINT (vscroll));
w->vscroll = min (w->vscroll, 0);
/* Adjust glyph matrix of the frame if the virtual display
@ -6180,7 +6173,7 @@ multiple of the canonical character height of WINDOW. */)
XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
}
return Fwindow_vscroll (window);
return Fwindow_vscroll (window, pixels_p);
}

6
src/window.h
View file

@ -320,7 +320,7 @@ struct window
| | +--------------------------- LEFT_MARGIN_COLS
| +------------------------------- LEFT_FRINGE_WIDTH
+---------------------------------- LEFT_SCROLL_BAR_COLS
*/
@ -767,8 +767,8 @@ EXFUN (Fdisplay_buffer, 3);
EXFUN (Fset_window_buffer, 3);
EXFUN (Fset_window_hscroll, 2);
EXFUN (Fwindow_hscroll, 1);
EXFUN (Fset_window_vscroll, 2);
EXFUN (Fwindow_vscroll, 1);
EXFUN (Fset_window_vscroll, 3);
EXFUN (Fwindow_vscroll, 2);
EXFUN (Fset_window_margins, 3);
EXFUN (Fwindow_live_p, 1);
EXFUN (Fset_window_point, 2);

202
src/xdisp.c
View file

@ -301,6 +301,7 @@ extern Lisp_Object Qface, Qinvisible, Qwidth;
Lisp_Object Vdisplay_pixels_per_inch;
Lisp_Object Qspace, QCalign_to, QCrelative_width, QCrelative_height;
Lisp_Object Qleft_margin, Qright_margin, Qspace_width, Qraise;
Lisp_Object Qslice;
Lisp_Object Qcenter;
Lisp_Object Qmargin, Qpointer;
extern Lisp_Object Qheight;
@ -1231,9 +1232,9 @@ line_bottom_y (it)
and header-lines heights. */
int
pos_visible_p (w, charpos, fully, exact_mode_line_heights_p)
pos_visible_p (w, charpos, fully, x, y, exact_mode_line_heights_p)
struct window *w;
int charpos, *fully, exact_mode_line_heights_p;
int charpos, *fully, *x, *y, exact_mode_line_heights_p;
{
struct it it;
struct text_pos top;
@ -1281,14 +1282,27 @@ pos_visible_p (w, charpos, fully, exact_mode_line_heights_p)
visible_p = 1;
*fully = bottom_y <= it.last_visible_y;
}
if (visible_p && x)
{
*x = it.current_x;
*y = max (top_y + it.max_ascent - it.ascent, window_top_y);
}
}
else if (it.current_y + it.max_ascent + it.max_descent > it.last_visible_y)
{
struct it it2;
it2 = it;
move_it_by_lines (&it, 1, 0);
if (charpos < IT_CHARPOS (it))
{
visible_p = 1;
*fully = 0;
if (x)
{
move_it_to (&it2, charpos, -1, -1, -1, MOVE_TO_POS);
*x = it2.current_x;
*y = it2.current_y + it2.max_ascent - it2.ascent;
}
}
}
@ -1296,6 +1310,7 @@ pos_visible_p (w, charpos, fully, exact_mode_line_heights_p)
set_buffer_internal_1 (old_buffer);
current_header_line_height = current_mode_line_height = -1;
return visible_p;
}
@ -2063,7 +2078,8 @@ init_iterator (it, w, charpos, bytepos, row, base_face_id)
if (FRAME_FACE_CACHE (it->f)->used == 0)
recompute_basic_faces (it->f);
/* Current value of the `space-width', and 'height' properties. */
/* Current value of the `slice', `space-width', and 'height' properties. */
it->slice.x = it->slice.y = it->slice.width = it->slice.height = Qnil;
it->space_width = Qnil;
it->font_height = Qnil;
@ -3271,8 +3287,9 @@ handle_display_prop (it)
}
/* Reset those iterator values set from display property values. */
it->font_height = Qnil;
it->slice.x = it->slice.y = it->slice.width = it->slice.height = Qnil;
it->space_width = Qnil;
it->font_height = Qnil;
it->voffset = 0;
/* We don't support recursive `display' properties, i.e. string
@ -3291,6 +3308,7 @@ handle_display_prop (it)
&& !EQ (XCAR (prop), Qimage)
&& !EQ (XCAR (prop), Qspace)
&& !EQ (XCAR (prop), Qwhen)
&& !EQ (XCAR (prop), Qslice)
&& !EQ (XCAR (prop), Qspace_width)
&& !EQ (XCAR (prop), Qheight)
&& !EQ (XCAR (prop), Qraise)
@ -3486,6 +3504,30 @@ handle_single_display_prop (it, prop, object, position,
if (NUMBERP (value) && XFLOATINT (value) > 0)
it->space_width = value;
}
else if (CONSP (prop)
&& EQ (XCAR (prop), Qslice))
{
/* `(slice X Y WIDTH HEIGHT)'. */
Lisp_Object tem;
if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f))
return 0;
if (tem = XCDR (prop), CONSP (tem))
{
it->slice.x = XCAR (tem);
if (tem = XCDR (tem), CONSP (tem))
{
it->slice.y = XCAR (tem);
if (tem = XCDR (tem), CONSP (tem))
{
it->slice.width = XCAR (tem);
if (tem = XCDR (tem), CONSP (tem))
it->slice.height = XCAR (tem);
}
}
}
}
else if (CONSP (prop)
&& EQ (XCAR (prop), Qraise)
&& CONSP (XCDR (prop)))
@ -4327,6 +4369,7 @@ push_it (it)
p->string_nchars = it->string_nchars;
p->area = it->area;
p->multibyte_p = it->multibyte_p;
p->slice = it->slice;
p->space_width = it->space_width;
p->font_height = it->font_height;
p->voffset = it->voffset;
@ -4359,6 +4402,7 @@ pop_it (it)
it->string_nchars = p->string_nchars;
it->area = p->area;
it->multibyte_p = p->multibyte_p;
it->slice = p->slice;
it->space_width = p->space_width;
it->font_height = p->font_height;
it->voffset = p->voffset;
@ -10758,15 +10802,14 @@ make_cursor_line_fully_visible (w, force_p)
if (!MATRIX_ROW_PARTIALLY_VISIBLE_P (row))
return 1;
if (force_p)
return 0;
/* If the row the cursor is in is taller than the window's height,
it's not clear what to do, so do nothing. */
window_height = window_box_height (w);
if (row->height >= window_height)
return 1;
{
if (!force_p || w->vscroll)
return 1;
}
return 0;
#if 0
@ -14153,8 +14196,12 @@ append_space (it, default_face_p)
face = FACE_FROM_ID (it->f, it->face_id);
it->face_id = FACE_FOR_CHAR (it->f, face, 0);
if (it->max_ascent > 0 || it->max_descent > 0)
it->constrain_row_ascent_descent_p = 1;
PRODUCE_GLYPHS (it);
it->constrain_row_ascent_descent_p = 0;
it->current_x = saved_x;
it->object = saved_object;
it->position = saved_pos;
@ -17301,6 +17348,7 @@ fill_image_glyph_string (s)
xassert (s->first_glyph->type == IMAGE_GLYPH);
s->img = IMAGE_FROM_ID (s->f, s->first_glyph->u.img_id);
xassert (s->img);
s->slice = s->first_glyph->slice;
s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
s->font = s->face->font;
s->width = s->first_glyph->pixel_width;
@ -18099,7 +18147,7 @@ take_vertical_position_into_account (it)
if (it->voffset < 0)
/* Increase the ascent so that we can display the text higher
in the line. */
it->ascent += abs (it->voffset);
it->ascent -= it->voffset;
else
/* Increase the descent so that we can display the text lower
in the line. */
@ -18119,6 +18167,7 @@ produce_image_glyph (it)
struct image *img;
struct face *face;
int face_ascent, glyph_ascent;
struct glyph_slice slice;
xassert (it->what == IT_IMAGE);
@ -18142,19 +18191,68 @@ produce_image_glyph (it)
/* Make sure X resources of the image is loaded. */
prepare_image_for_display (it->f, img);
it->ascent = it->phys_ascent = glyph_ascent = image_ascent (img, face);
it->descent = it->phys_descent = img->height + 2 * img->vmargin - it->ascent;
it->pixel_width = img->width + 2 * img->hmargin;
slice.x = slice.y = 0;
slice.width = img->width;
slice.height = img->height;
if (INTEGERP (it->slice.x))
slice.x = XINT (it->slice.x);
else if (FLOATP (it->slice.x))
slice.x = XFLOAT_DATA (it->slice.x) * img->width;
if (INTEGERP (it->slice.y))
slice.y = XINT (it->slice.y);
else if (FLOATP (it->slice.y))
slice.y = XFLOAT_DATA (it->slice.y) * img->height;
if (INTEGERP (it->slice.width))
slice.width = XINT (it->slice.width);
else if (FLOATP (it->slice.width))
slice.width = XFLOAT_DATA (it->slice.width) * img->width;
if (INTEGERP (it->slice.height))
slice.height = XINT (it->slice.height);
else if (FLOATP (it->slice.height))
slice.height = XFLOAT_DATA (it->slice.height) * img->height;
if (slice.x >= img->width)
slice.x = img->width;
if (slice.y >= img->height)
slice.y = img->height;
if (slice.x + slice.width >= img->width)
slice.width = img->width - slice.x;
if (slice.y + slice.height > img->height)
slice.height = img->height - slice.y;
if (slice.width == 0 || slice.height == 0)
return;
it->ascent = it->phys_ascent = glyph_ascent = image_ascent (img, face, &slice);
it->descent = slice.height - glyph_ascent;
if (slice.y == 0)
it->descent += img->vmargin;
if (slice.y + slice.height == img->height)
it->descent += img->vmargin;
it->phys_descent = it->descent;
it->pixel_width = slice.width;
if (slice.x == 0)
it->pixel_width += img->hmargin;
if (slice.x + slice.width == img->width)
it->pixel_width += img->hmargin;
/* It's quite possible for images to have an ascent greater than
their height, so don't get confused in that case. */
if (it->descent < 0)
it->descent = 0;
#if 0 /* this breaks image tiling */
/* If this glyph is alone on the last line, adjust it.ascent to minimum row ascent. */
face_ascent = face->font ? FONT_BASE (face->font) : FRAME_BASELINE_OFFSET (it->f);
if (face_ascent > it->ascent)
it->ascent = it->phys_ascent = face_ascent;
#endif
it->nglyphs = 1;
@ -18162,13 +18260,15 @@ produce_image_glyph (it)
{
if (face->box_line_width > 0)
{
it->ascent += face->box_line_width;
it->descent += face->box_line_width;
if (slice.y == 0)
it->ascent += face->box_line_width;
if (slice.y + slice.height == img->height)
it->descent += face->box_line_width;
}
if (it->start_of_box_run_p)
if (it->start_of_box_run_p && slice.x == 0)
it->pixel_width += abs (face->box_line_width);
if (it->end_of_box_run_p)
if (it->end_of_box_run_p && slice.x + slice.width == img->width)
it->pixel_width += abs (face->box_line_width);
}
@ -18197,6 +18297,7 @@ produce_image_glyph (it)
glyph->glyph_not_available_p = 0;
glyph->face_id = it->face_id;
glyph->u.img_id = img->id;
glyph->slice = slice;
glyph->font_type = FONT_TYPE_UNKNOWN;
++it->glyph_row->used[area];
}
@ -18488,8 +18589,9 @@ x_produce_glyphs (it)
it->nglyphs = 1;
pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b,
FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display));
pcm = FRAME_RIF (it->f)->per_char_metric
(font, &char2b, FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display));
it->ascent = FONT_BASE (font) + boff;
it->descent = FONT_DESCENT (font) - boff;
@ -18502,11 +18604,27 @@ x_produce_glyphs (it)
else
{
it->glyph_not_available_p = 1;
it->phys_ascent = FONT_BASE (font) + boff;
it->phys_descent = FONT_DESCENT (font) - boff;
it->phys_ascent = it->ascent;
it->phys_descent = it->descent;
it->pixel_width = FONT_WIDTH (font);
}
if (it->constrain_row_ascent_descent_p)
{
if (it->descent > it->max_descent)
{
it->ascent += it->descent - it->max_descent;
it->descent = it->max_descent;
}
if (it->ascent> it->max_ascent)
{
it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent);
it->ascent = it->max_ascent;
}
it->phys_ascent = min (it->phys_ascent, it->ascent);
it->phys_descent = min (it->phys_descent, it->descent);
}
/* If this is a space inside a region of text with
`space-width' property, change its width. */
stretched_p = it->char_to_display == ' ' && !NILP (it->space_width);
@ -18539,6 +18657,14 @@ x_produce_glyphs (it)
if (face->overline_p)
it->ascent += 2;
if (it->constrain_row_ascent_descent_p)
{
if (it->ascent > it->max_ascent)
it->ascent = it->max_ascent;
if (it->descent > it->max_descent)
it->descent = it->max_descent;
}
take_vertical_position_into_account (it);
/* If we have to actually produce glyphs, do it. */
@ -18565,13 +18691,31 @@ x_produce_glyphs (it)
}
else if (it->char_to_display == '\n')
{
/* A newline has no width but we need the height of the line. */
/* A newline has no width but we need the height of the line.
But if previous part of the line set a height, don't
increase that height */
it->pixel_width = 0;
it->nglyphs = 0;
it->ascent = it->phys_ascent = FONT_BASE (font) + boff;
it->descent = it->phys_descent = FONT_DESCENT (font) - boff;
if (face->box != FACE_NO_BOX
it->ascent = FONT_BASE (font) + boff;
it->descent = FONT_DESCENT (font) - boff;
if (it->max_ascent > 0 || it->max_descent > 0)
{
it->ascent = it->descent = 0;
}
else
{
it->ascent = FONT_BASE (font) + boff;
it->descent = FONT_DESCENT (font) - boff;
}
it->phys_ascent = it->ascent;
it->phys_descent = it->descent;
if ((it->max_ascent > 0 || it->max_descent > 0)
&& face->box != FACE_NO_BOX
&& face->box_line_width > 0)
{
it->ascent += face->box_line_width;
@ -20544,7 +20688,9 @@ note_mouse_highlight (f, x, y)
Lisp_Object image_map, hotspot;
if ((image_map = Fplist_get (XCDR (img->spec), QCmap),
!NILP (image_map))
&& (hotspot = find_hot_spot (image_map, dx, dy),
&& (hotspot = find_hot_spot (image_map,
glyph->slice.x + dx,
glyph->slice.y + dy),
CONSP (hotspot))
&& (hotspot = XCDR (hotspot), CONSP (hotspot)))
{
@ -21583,6 +21729,8 @@ syms_of_xdisp ()
staticpro (&Qspace_width);
Qraise = intern ("raise");
staticpro (&Qraise);
Qslice = intern ("slice");
staticpro (&Qslice);
Qspace = intern ("space");
staticpro (&Qspace);
Qmargin = intern ("margin");

154
src/xterm.c
View file

@ -982,7 +982,8 @@ static void x_draw_image_foreground_1 P_ ((struct glyph_string *, Pixmap));
static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
int, int, int));
static void x_draw_relief_rect P_ ((struct frame *, int, int, int, int,
int, int, int, int, XRectangle *));
int, int, int, int, int, int,
XRectangle *));
static void x_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
int, int, int, XRectangle *));
@ -2021,9 +2022,10 @@ x_setup_relief_colors (s)
static void
x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
raised_p, left_p, right_p, clip_rect)
raised_p, top_p, bot_p, left_p, right_p, clip_rect)
struct frame *f;
int left_x, top_y, right_x, bottom_y, width, left_p, right_p, raised_p;
int left_x, top_y, right_x, bottom_y, width;
int top_p, bot_p, left_p, right_p, raised_p;
XRectangle *clip_rect;
{
Display *dpy = FRAME_X_DISPLAY (f);
@ -2038,10 +2040,11 @@ x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
/* Top. */
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, top_y + i,
right_x + 1 - i * right_p, top_y + i);
if (top_p)
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, top_y + i,
right_x + 1 - i * right_p, top_y + i);
/* Left. */
if (left_p)
@ -2057,10 +2060,11 @@ x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
/* Bottom. */
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, bottom_y - i,
right_x + 1 - i * right_p, bottom_y - i);
if (bot_p)
for (i = 0; i < width; ++i)
XDrawLine (dpy, window, gc,
left_x + i * left_p, bottom_y - i,
right_x + 1 - i * right_p, bottom_y - i);
/* Right. */
if (right_p)
@ -2168,7 +2172,7 @@ x_draw_glyph_string_box (s)
{
x_setup_relief_colors (s);
x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
width, raised_p, left_p, right_p, &clip_rect);
width, raised_p, 1, 1, left_p, right_p, &clip_rect);
}
}
@ -2179,21 +2183,22 @@ static void
x_draw_image_foreground (s)
struct glyph_string *s;
{
int x;
int y = s->ybase - image_ascent (s->img, s->face);
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
x = s->x;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->img->pixmap)
{
@ -2218,11 +2223,12 @@ x_draw_image_foreground (s)
get_glyph_string_clip_rect (s, &clip_rect);
image_rect.x = x;
image_rect.y = y;
image_rect.width = s->img->width;
image_rect.height = s->img->height;
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
r.x - x, r.y - y, r.width, r.height, r.x, r.y);
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.width, r.height, r.x, r.y);
}
else
{
@ -2231,11 +2237,12 @@ x_draw_image_foreground (s)
get_glyph_string_clip_rect (s, &clip_rect);
image_rect.x = x;
image_rect.y = y;
image_rect.width = s->img->width;
image_rect.height = s->img->height;
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
r.x - x, r.y - y, r.width, r.height, r.x, r.y);
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.width, r.height, r.x, r.y);
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
@ -2247,15 +2254,17 @@ x_draw_image_foreground (s)
{
int r = s->img->relief;
if (r < 0) r = -r;
XDrawRectangle (s->display, s->window, s->gc, x - r, y - r,
s->img->width + r*2 - 1, s->img->height + r*2 - 1);
XDrawRectangle (s->display, s->window, s->gc,
x - r, y - r,
s->slice.width + r*2 - 1,
s->slice.height + r*2 - 1);
}
}
}
else
/* Draw a rectangle if image could not be loaded. */
XDrawRectangle (s->display, s->window, s->gc, x, y,
s->img->width - 1, s->img->height - 1);
s->slice.width - 1, s->slice.height - 1);
}
@ -2267,21 +2276,22 @@ x_draw_image_relief (s)
{
int x0, y0, x1, y1, thick, raised_p;
XRectangle r;
int x;
int y = s->ybase - image_ascent (s->img, s->face);
int x = s->x;
int y = s->ybase - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + abs (s->face->box_line_width);
else
x = s->x;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
@ -2297,12 +2307,17 @@ x_draw_image_relief (s)
x0 = x - thick;
y0 = y - thick;
x1 = x + s->img->width + thick - 1;
y1 = y + s->img->height + thick - 1;
x1 = x + s->slice.width + thick - 1;
y1 = y + s->slice.height + thick - 1;
x_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
x_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
x_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p,
s->slice.y == 0,
s->slice.y + s->slice.height == s->img->height,
s->slice.x == 0,
s->slice.x + s->slice.width == s->img->width,
&r);
}
@ -2313,21 +2328,22 @@ x_draw_image_foreground_1 (s, pixmap)
struct glyph_string *s;
Pixmap pixmap;
{
int x;
int y = s->ybase - s->y - image_ascent (s->img, s->face);
int x = 0;
int y = s->ybase - s->y - image_ascent (s->img, s->face, &s->slice);
/* If first glyph of S has a left box line, start drawing it to the
right of that line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = abs (s->face->box_line_width);
else
x = 0;
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += abs (s->face->box_line_width);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
x += s->img->hmargin;
y += s->img->vmargin;
if (s->slice.x == 0)
x += s->img->hmargin;
if (s->slice.y == 0)
y += s->img->vmargin;
if (s->img->pixmap)
{
@ -2349,13 +2365,15 @@ x_draw_image_foreground_1 (s, pixmap)
XChangeGC (s->display, s->gc, mask, &xgcv);
XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
0, 0, s->img->width, s->img->height, x, y);
s->slice.x, s->slice.y,
s->slice.width, s->slice.height, x, y);
XSetClipMask (s->display, s->gc, None);
}
else
{
XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
0, 0, s->img->width, s->img->height, x, y);
s->slice.x, s->slice.y,
s->slice.width, s->slice.height, x, y);
/* When the image has a mask, we can expect that at
least part of a mouse highlight or a block cursor will
@ -2368,14 +2386,15 @@ x_draw_image_foreground_1 (s, pixmap)
int r = s->img->relief;
if (r < 0) r = -r;
XDrawRectangle (s->display, s->window, s->gc, x - r, y - r,
s->img->width + r*2 - 1, s->img->height + r*2 - 1);
s->slice.width + r*2 - 1,
s->slice.height + r*2 - 1);
}
}
}
else
/* Draw a rectangle if image could not be loaded. */
XDrawRectangle (s->display, pixmap, s->gc, x, y,
s->img->width - 1, s->img->height - 1);
s->slice.width - 1, s->slice.height - 1);
}
@ -2417,33 +2436,28 @@ static void
x_draw_image_glyph_string (s)
struct glyph_string *s;
{
int x, y;
int box_line_hwidth = abs (s->face->box_line_width);
int box_line_vwidth = max (s->face->box_line_width, 0);
int height;
Pixmap pixmap = None;
height = s->height - 2 * box_line_vwidth;
height = s->height;
if (s->slice.y == 0)
height -= box_line_vwidth;
if (s->slice.y + s->slice.height >= s->img->height)
height -= box_line_vwidth;
/* Fill background with face under the image. Do it only if row is
taller than image or if image has a clip mask to reduce
flickering. */
s->stippled_p = s->face->stipple != 0;
if (height > s->img->height
if (height > s->slice.height
|| s->img->hmargin
|| s->img->vmargin
|| s->img->mask
|| s->img->pixmap == 0
|| s->width != s->background_width)
{
if (box_line_hwidth && s->first_glyph->left_box_line_p)
x = s->x + box_line_hwidth;
else
x = s->x;
y = s->y + box_line_vwidth;
if (s->img->mask)
{
/* Create a pixmap as large as the glyph string. Fill it
@ -2482,7 +2496,19 @@ x_draw_image_glyph_string (s)
}
}
else
x_draw_glyph_string_bg_rect (s, x, y, s->background_width, height);
{
int x = s->x;
int y = s->y;
if (s->first_glyph->left_box_line_p
&& s->slice.x == 0)
x += box_line_hwidth;
if (s->slice.y == 0)
y += box_line_vwidth;
x_draw_glyph_string_bg_rect (s, x, y, s->background_width, height);
}
s->background_filled_p = 1;
}

1
src/xterm.h
View file

@ -941,7 +941,6 @@ Lisp_Object display_x_get_resource P_ ((struct x_display_info *,
struct frame *check_x_frame P_ ((Lisp_Object));
EXFUN (Fx_display_color_p, 1);
EXFUN (Fx_display_grayscale_p, 1);
int image_ascent P_ ((struct image *, struct face *));
extern void x_free_gcs P_ ((struct frame *));
/* From xrdb.c. */