Mercurial > emacs
changeset 83112:30dd490f06f2
Merged in changes from CVS trunk.
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
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Fri, 23 Apr 2004 14:44:11 +0000 |
| parents | fd147ed0d1b8 (current diff) 4f9eee6a3018 (diff) |
| children | 1a68e4b22355 |
| files | etc/TODO lisp/ChangeLog lisp/Makefile.in lisp/emacs-lisp/bytecomp.el lisp/frame.el lisp/recentf.el lisp/simple.el lisp/x-dnd.el src/dispextern.h src/dispnew.c src/fontset.c src/keyboard.c src/keymap.c src/lisp.h src/macterm.c src/w32term.c src/w32term.h src/window.c src/window.h src/xdisp.c src/xterm.c src/xterm.h |
| diffstat | 87 files changed, 2175 insertions(+), 1076 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/etc/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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
--- a/etc/NEWS Fri Apr 23 13:56:26 2004 +0000 +++ b/etc/NEWS Fri Apr 23 14:44:11 2004 +0000 @@ -88,6 +88,11 @@ * 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 @@ 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 @@ * 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 @@ 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
--- a/etc/TODO Fri Apr 23 13:56:26 2004 +0000 +++ b/etc/TODO Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ 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 @@ 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: + +** 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, ... -* Have a command suggestion help system that recognizes patterns +** 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 @@ 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 @@ 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 @@ 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 @@ 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
--- a/leim/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/leim/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/leim/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/leim/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/lib-src/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/lib-src/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/lib-src/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/lib-src/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/lisp/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/lisp/ChangeLog.10 Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/ChangeLog.10 Fri Apr 23 14:44:11 2004 +0000 @@ -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)
--- a/lisp/Makefile.in Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/Makefile.in Fri Apr 23 14:44:11 2004 +0000 @@ -282,7 +282,7 @@ # .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
--- a/lisp/add-log.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/add-log.el Fri Apr 23 14:44:11 2004 +0000 @@ -445,7 +445,7 @@ (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'.
--- a/lisp/autoinsert.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/autoinsert.el Fri Apr 23 14:44:11 2004 +0000 @@ -136,7 +136,7 @@ (("\\.[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.
--- a/lisp/calendar/time-date.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/calendar/time-date.el Fri Apr 23 14:44:11 2004 +0000 @@ -149,7 +149,7 @@ ;;;###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))
--- a/lisp/cvs-status.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/cvs-status.el Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ ;;;; 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 @@ "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.
--- a/lisp/dabbrev.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/dabbrev.el Fri Apr 23 14:44:11 2004 +0000 @@ -888,23 +888,28 @@ ;; 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))
--- a/lisp/descr-text.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/descr-text.el Fri Apr 23 14:44:11 2004 +0000 @@ -474,6 +474,7 @@ 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 @@ (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 @@ (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")
--- a/lisp/desktop.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/desktop.el Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ (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 @@ :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-buffer-file-name + desktop-buffer-name + desktop-buffer-misc + +Furthermore, they may use the following variables: desktop-file-version - desktop-buffer-file-name - desktop-buffer-name 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 @@ (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 @@ "~")))) (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ 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
--- a/lisp/diff-mode.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/diff-mode.el Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ (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 @@ ;; (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))
--- a/lisp/dired.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/dired.el Fri Apr 23 14:44:11 2004 +0000 @@ -1402,6 +1402,8 @@ (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 @@ (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)
--- a/lisp/emacs-lisp/byte-run.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/emacs-lisp/byte-run.el Fri Apr 23 14:44:11 2004 +0000 @@ -134,11 +134,10 @@ ;; 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.
--- a/lisp/emacs-lisp/bytecomp.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Fri Apr 23 14:44:11 2004 +0000 @@ -3716,7 +3716,7 @@ (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 @@ 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 @@ (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))
--- a/lisp/emacs-lisp/checkdoc.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/emacs-lisp/checkdoc.el Fri Apr 23 14:44:11 2004 +0000 @@ -2604,18 +2604,13 @@ (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 @@ (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."
--- a/lisp/emacs-lisp/disass.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/emacs-lisp/disass.el Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ (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
--- a/lisp/emacs-lisp/easymenu.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/emacs-lisp/easymenu.el Fri Apr 23 14:44:11 2004 +0000 @@ -478,8 +478,8 @@ (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)
--- a/lisp/font-lock.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/font-lock.el Fri Apr 23 14:44:11 2004 +0000 @@ -1562,17 +1562,17 @@ (: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 @@ '((((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)
--- a/lisp/frame.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/frame.el Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ 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 @@ (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 @@ (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 @@ (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)
--- a/lisp/gnus/mailcap.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/gnus/mailcap.el Fri Apr 23 14:44:11 2004 +0000 @@ -271,6 +271,7 @@ 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.
--- a/lisp/help-fns.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/help-fns.el Fri Apr 23 14:44:11 2004 +0000 @@ -63,6 +63,7 @@ (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 @@ (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))
--- a/lisp/help-mode.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/help-mode.el Fri Apr 23 14:44:11 2004 +0000 @@ -195,14 +195,17 @@ ;;;###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.
--- a/lisp/image.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/image.el Fri Apr 23 14:44:11 2004 +0000 @@ -176,7 +176,7 @@ ;;;###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 @@ 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 @@ (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
--- a/lisp/info.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/info.el Fri Apr 23 14:44:11 2004 +0000 @@ -66,29 +66,29 @@ (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 @@ :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 @@ ;; 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 @@ (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 @@ "^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
--- a/lisp/international/mule-cmds.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/international/mule-cmds.el Fri Apr 23 14:44:11 2004 +0000 @@ -1054,7 +1054,7 @@ 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 @@ :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 @@ (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 @@ 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)
--- a/lisp/international/mule-util.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/international/mule-util.el Fri Apr 23 14:44:11 2004 +0000 @@ -373,27 +373,7 @@ ;; 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
--- a/lisp/international/mule.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/international/mule.el Fri Apr 23 14:44:11 2004 +0000 @@ -1401,9 +1401,9 @@ (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)))
--- a/lisp/international/quail.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/international/quail.el Fri Apr 23 14:44:11 2004 +0000 @@ -1218,7 +1218,7 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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))
--- a/lisp/iswitchb.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/iswitchb.el Fri Apr 23 14:44:11 2004 +0000 @@ -300,9 +300,11 @@ (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
--- a/lisp/mail/rmail.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/mail/rmail.el Fri Apr 23 14:44:11 2004 +0000 @@ -3867,6 +3867,23 @@ (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
--- a/lisp/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ progmodes \ term \ textmodes \ - toolbar + toolbar \ + url doit:
--- a/lisp/menu-bar.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/menu-bar.el Fri Apr 23 14:44:11 2004 +0000 @@ -1557,7 +1557,8 @@ (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)
--- a/lisp/mh-e/mh-e.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/mh-e/mh-e.el Fri Apr 23 14:44:11 2004 +0000 @@ -2441,6 +2441,17 @@ "^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:
--- a/lisp/net/telnet.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/net/telnet.el Fri Apr 23 14:44:11 2004 +0000 @@ -197,18 +197,28 @@ ;;;###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 @@ ;; 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))))
--- a/lisp/progmodes/cc-cmds.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/progmodes/cc-cmds.el Fri Apr 23 14:44:11 2004 +0000 @@ -1488,7 +1488,7 @@ (save-excursion (beginning-of-line) (or (not (re-search-backward - sentence-end + (sentence-end) (c-point 'bopl) t)) (< (match-end 0)
--- a/lisp/progmodes/compile.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/progmodes/compile.el Fri Apr 23 14:44:11 2004 +0000 @@ -125,11 +125,6 @@ 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 @@ (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 @@ (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 @@ ,(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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ ;; 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 @@ (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 @@ (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
--- a/lisp/progmodes/cperl-mode.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/progmodes/cperl-mode.el Fri Apr 23 14:44:11 2004 +0000 @@ -926,12 +926,9 @@ (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)
--- a/lisp/progmodes/gdb-ui.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/progmodes/gdb-ui.el Fri Apr 23 14:44:11 2004 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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
--- a/lisp/progmodes/python.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/progmodes/python.el Fri Apr 23 14:44:11 2004 +0000 @@ -1415,7 +1415,7 @@ (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))))
--- a/lisp/recentf.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/recentf.el Fri Apr 23 14:44:11 2004 +0000 @@ -1137,13 +1137,16 @@ "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.
--- a/lisp/replace.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/replace.el Fri Apr 23 14:44:11 2004 +0000 @@ -538,6 +538,7 @@ (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 @@ "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 @@ (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))))
--- a/lisp/simple.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/simple.el Fri Apr 23 14:44:11 2004 +0000 @@ -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."
--- a/lisp/subr.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/subr.el Fri Apr 23 14:44:11 2004 +0000 @@ -644,14 +644,16 @@ (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 @@ (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)))))
--- a/lisp/textmodes/fill.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/textmodes/fill.el Fri Apr 23 14:44:11 2004 +0000 @@ -155,7 +155,7 @@ 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 @@ (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 @@ ;; 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
--- a/lisp/textmodes/paragraphs.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/textmodes/paragraphs.el Fri Apr 23 14:44:11 2004 +0000 @@ -120,49 +120,62 @@ 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. +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 '(choice regexp (const :tag "Use default value" nil))) + +(defun sentence-end () + "Return the regexp describing the end of a sentence. -See also the variable `sentence-end-double-space', the variable -`sentence-end-without-period' and Info node `Sentences'." - :group 'paragraphs - :type 'regexp) +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 @@ 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))))
--- a/lisp/vc-svn.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/vc-svn.el Fri Apr 23 14:44:11 2004 +0000 @@ -334,21 +334,22 @@ ;;; 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 @@ ;; 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 @@ (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 @@ (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."
--- a/lisp/view.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/view.el Fri Apr 23 14:44:11 2004 +0000 @@ -137,6 +137,7 @@ 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.
--- a/lisp/window.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/window.el Fri Apr 23 14:44:11 2004 +0000 @@ -327,8 +327,9 @@ (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)
--- a/lisp/x-dnd.el Fri Apr 23 13:56:26 2004 +0000 +++ b/lisp/x-dnd.el Fri Apr 23 14:44:11 2004 +0000 @@ -309,14 +309,13 @@ 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 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)
--- a/lispintro/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/lispintro/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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
--- a/lispintro/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/lispintro/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/lispref/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/lispref/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/lispref/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/lispref/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/man/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/man/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/man/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/man/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/man/widget.texi Fri Apr 23 13:56:26 2004 +0000 +++ b/man/widget.texi Fri Apr 23 14:44:11 2004 +0000 @@ -680,7 +680,7 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ @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 @@ 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 @@ @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 @@ @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 @@ @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 @@ 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 @@ @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
--- a/nt/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/nt/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/nt/gmake.defs Fri Apr 23 13:56:26 2004 +0000 +++ b/nt/gmake.defs Fri Apr 23 14:44:11 2004 +0000 @@ -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
--- a/nt/makefile.def Fri Apr 23 13:56:26 2004 +0000 +++ b/nt/makefile.def Fri Apr 23 14:44:11 2004 +0000 @@ -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
--- a/nt/makefile.nt Fri Apr 23 13:56:26 2004 +0000 +++ b/nt/makefile.nt Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/nt/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/nt/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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
--- a/nt/nmake.defs Fri Apr 23 13:56:26 2004 +0000 +++ b/nt/nmake.defs Fri Apr 23 14:44:11 2004 +0000 @@ -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
--- a/src/ChangeLog Fri Apr 23 13:56:26 2004 +0000 +++ b/src/ChangeLog Fri Apr 23 14:44:11 2004 +0000 @@ -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>
--- a/src/dispextern.h Fri Apr 23 13:56:26 2004 +0000 +++ b/src/dispextern.h Fri Apr 23 14:44:11 2004 +0000 @@ -274,6 +274,17 @@ }; +/* 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 @@ 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 @@ #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 @@ /* Image, if any. */ struct image *img; + /* Slice */ + struct glyph_slice slice; + struct glyph_string *next, *prev; }; @@ -1607,7 +1632,7 @@ 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 @@ }; +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 @@ 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 @@ 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 @@ /* 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 @@ 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 @@ 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 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 @@ 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 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 *,
--- a/src/dispnew.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/dispnew.c Fri Apr 23 14:44:11 2004 +0000 @@ -5740,6 +5740,9 @@ 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 @@ #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 @@ 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 @@ if (img != NULL) *object = img->spec; y0 -= row->ascent - glyph->ascent; + x0 += glyph->slice.x; + y0 += glyph->slice.y; } #endif }
--- a/src/fns.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/fns.c Fri Apr 23 14:44:11 2004 +0000 @@ -1560,7 +1560,7 @@ 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 @@ 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 @@ defsubr (&Sput); defsubr (&Slax_plist_get); defsubr (&Slax_plist_put); + defsubr (&Seql); defsubr (&Sequal); defsubr (&Sequal_including_properties); defsubr (&Sfillarray);
--- a/src/fontset.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/fontset.c Fri Apr 23 14:44:11 2004 +0000 @@ -195,7 +195,7 @@ 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 @@ 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 @@ 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 @@ /* 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 @@ (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 @@ 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 @@ 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;
--- a/src/image.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/image.c Fri Apr 23 14:44:11 2004 +0000 @@ -1076,13 +1076,21 @@ drawn in face FACE. */ int -image_ascent (img, face) +image_ascent (img, face, slice) struct image *img; struct face *face; -{ - int height = img->height + img->vmargin; + struct glyph_slice *slice; +{ + 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)
--- a/src/keyboard.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/keyboard.c Fri Apr 23 14:44:11 2004 +0000 @@ -10618,6 +10618,61 @@ 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 @@ 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. */);
--- a/src/keymap.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/keymap.c Fri Apr 23 14:44:11 2004 +0000 @@ -1959,14 +1959,14 @@ 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 @@ 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);
--- a/src/lisp.h Fri Apr 23 13:56:26 2004 +0000 +++ b/src/lisp.h Fri Apr 23 14:44:11 2004 +0000 @@ -382,7 +382,7 @@ #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 @@ 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 @@ 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) ()));
--- a/src/macterm.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/macterm.c Fri Apr 23 14:44:11 2004 +0000 @@ -294,7 +294,6 @@ 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 @@ Display *display; /* not used */ Pixmap pixmap; { - DisposeGWorld (pixmap); + DisposeGWorld (pixmap); } @@ -1283,7 +1282,7 @@ 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 @@ : 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_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 @@ 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 @@ 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 @@ 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_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 @@ 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 @@ 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 @@ 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 @@ { 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 @@ { 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 @@ 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 @@ 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 @@ 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 @@ 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; + 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; if (s->img->mask) { @@ -3842,7 +3862,7 @@ /* 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 @@ 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 @@ 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 @@ break; case smKorean: coding_system = Qeuc_kr; - break; + break; default: return; } @@ -6277,7 +6297,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ /* 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 @@ 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
--- a/src/makefile.w32-in Fri Apr 23 13:56:26 2004 +0000 +++ b/src/makefile.w32-in Fri Apr 23 14:44:11 2004 +0000 @@ -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.
--- a/src/w32term.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/w32term.c Fri Apr 23 14:44:11 2004 +0000 @@ -1220,7 +1220,8 @@ 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 @@ 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_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 @@ 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_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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ { 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 @@ 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 @@ { 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 @@ 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 @@ 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 @@ { 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 @@ 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 @@ 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; + 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; + #if 0 /* TODO: figure out if we need to do this on Windows. */ if (s->img->mask) {
--- a/src/w32term.h Fri Apr 23 13:56:26 2004 +0000 +++ b/src/w32term.h Fri Apr 23 14:44:11 2004 +0000 @@ -719,7 +719,6 @@ 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)
--- a/src/window.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/window.c Fri Apr 23 14:44:11 2004 +0000 @@ -324,7 +324,11 @@ 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 @@ 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 @@ 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 @@ 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 @@ ++update_mode_lines; return Qt; } - + if (STRINGP (object)) object = Fget_buffer (object); if (BUFFERP (object) && !NILP (XBUFFER (object)->name)) @@ -3549,7 +3536,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ { 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 @@ XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1; } - return Fwindow_vscroll (window); + return Fwindow_vscroll (window, pixels_p); }
--- a/src/window.h Fri Apr 23 13:56:26 2004 +0000 +++ b/src/window.h Fri Apr 23 14:44:11 2004 +0000 @@ -320,7 +320,7 @@ | | +--------------------------- LEFT_MARGIN_COLS | +------------------------------- LEFT_FRINGE_WIDTH +---------------------------------- LEFT_SCROLL_BAR_COLS - + */ @@ -767,8 +767,8 @@ 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);
--- a/src/xdisp.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/xdisp.c Fri Apr 23 14:44:11 2004 +0000 @@ -301,6 +301,7 @@ 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 @@ and header-lines heights. */ int -pos_visible_p (w, charpos, fully, exact_mode_line_heights_p) - struct window *w; - int 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, *x, *y, exact_mode_line_heights_p; { struct it it; struct text_pos top; @@ -1281,14 +1282,27 @@ 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 @@ set_buffer_internal_1 (old_buffer); current_header_line_height = current_mode_line_height = -1; + return visible_p; } @@ -2063,7 +2078,8 @@ 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 @@ } /* Reset those iterator values set from display property values. */ + it->slice.x = it->slice.y = it->slice.width = it->slice.height = Qnil; + it->space_width = Qnil; it->font_height = Qnil; - it->space_width = Qnil; it->voffset = 0; /* We don't support recursive `display' properties, i.e. string @@ -3291,6 +3308,7 @@ && !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) @@ -3487,6 +3505,30 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ struct image *img; struct face *face; int face_ascent, glyph_ascent; + struct glyph_slice slice; xassert (it->what == IT_IMAGE); @@ -18142,19 +18191,68 @@ /* 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 @@ { if (face->box_line_width > 0) { - it->ascent += face->box_line_width; - it->descent += face->box_line_width; - } - - if (it->start_of_box_run_p) + 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 && 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ } 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 @@ 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 @@ staticpro (&Qspace_width); Qraise = intern ("raise"); staticpro (&Qraise); + Qslice = intern ("slice"); + staticpro (&Qslice); Qspace = intern ("space"); staticpro (&Qspace); Qmargin = intern ("margin");
--- a/src/xterm.c Fri Apr 23 13:56:26 2004 +0000 +++ b/src/xterm.c Fri Apr 23 14:44:11 2004 +0000 @@ -982,7 +982,8 @@ 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 @@ 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 @@ 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 @@ 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_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 @@ 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 @@ 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 @@ 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 @@ { 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 @@ { 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ } } 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; }
--- a/src/xterm.h Fri Apr 23 13:56:26 2004 +0000 +++ b/src/xterm.h Fri Apr 23 14:44:11 2004 +0000 @@ -941,7 +941,6 @@ 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. */