mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-03 08:30:09 +00:00
Code Issues Releases Activity

merge trunk

Browse Source
This commit is contained in:
Kenichi Handa 2010-08-25 14:15:20 +09:00
commit 4e603db342
95 changed files with 2998 additions and 1857 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
ChangeLog
View File

@ -1,3 +1,12 @@
2010-08-23 Andreas Schwab <schwab@linux-m68k.org>
* configure.in: Fix check for librsvg, imagemagick and
MagickExportImagePixels.
2010-08-18 Joakim Verona <joakim@verona.se>
* Makefile.in, configure.in: Checks for ImageMagick.
2010-08-10 Dan Nicolaescu <dann@ics.uci.edu>
* configure.in (AC_PREREQ): Require autoconf 2.65.

151
README.imagemagick Normal file
View File

@ -0,0 +1,151 @@
* README for the ImageMagick Emacs branch
This is the imagemagick branch of Emacs. Imagemagick can now be used
to load many new image formats, and also do useful transforms like
scaling and rotation.
This file will attempt to contain draft NEWS, Changelog and manual
entries for the new functionality.
You might need to regenerate the configure scripts:
aclocal
automake
autoheader
autoconf
./configure --with-imagemagick
* TODO image-type-header-regexps priorities the jpeg loader over the
imagemagick one. This is not wrong, but how should a user go about
prefering the imagemagick loader? The user might like zooming etc in
jpegs.
try (setq image-type-header-regexps nil) for a quick hack to prefer
imagemagick over the jpg loader.
* TODO For some reason its unbearably slow to look at a page in a large
image bundle using the :index feature. The imagemagick "display"
command is also a bit slow, but nowhere near as slow as the emacs
code. It seems imagemagick tries to unpack every page when loading
the bundle. This feature is not the primary usecase for the
imagemagick patch though.
ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load.
It is now way faster to use the :index feature, but its still not
very fast.
** DONE optimize number of pages calculation for bundles as suggested by
imagemagick forum: "set the density to something low like 2 and use
MagickPingImage()"
** TODO try to cache the num pages calculation. it can take a while to
calculate the number of pages, and if you need to do it for each
page view, page-flipping becomes uselessly slow.
* TODO integrate with image-dired
* TODO integrate with docview.
* TODO integrate with image-mode
Some work has been done, M-x image-transform-fit-to-height will fit
the image to the height of the Emacs window for instance.
* TODO look for optimizations for handling images with low depth
Currently the code seems to default to 24 bit RGB which is costly for
images with lower bit depth.
* TODO complete documentation drafts below
* DONE fix inconsistencys with spelling of imagemagick in the src
* DONE report number of images in image bundle types somehow
Works like for "gif" support. Thanks to Juri Linkov.
* DONE probably add pdf to inhibited types
* DONE inhibit types is defconst should probably be defcustom
* TODO decide what to do with some uncommitted imagemagick support
functions for image size etc.
* TODO Test with more systems
Tested on Fedora 12, Fedora 14 so far, and the libmagick that ships with it.
Ubuntu 8.04 was also tested, but it seems it ships a broken
ImageMagick.
I also tried using an imagemagick compiled from their SVN, in
parallell with the one packaged by Fedora, it worked well.
* DONE Also need some way to handle render methods that only work on newer ImageMagicks
Is handled by configure now
* Some nits from Stefan Monnier
I just took a quick look at the code and I see the following nits to fix:
** DONE obviously a merge will have to come with a good ChangeLog.
** DONE also the merge will need to come with documentation. Maybe not in the
Texinfo form yet, but at least in the etc/NEWS with enough info that
describes the `scale' and other such arguments that someone can start
using them.
** DONE the README talks about naming inconsistencies, I think these should be
fixed before a first commit (should be straightforward).
** DONE the "let" in image.el should not be followed by a line break and the while
should be replaced by a dolist.
** DONE the prototype of imagemagick_load_image has some odd indentation in ([[2010.06.14]])
its args, not sure what happened.
** DONE a few lines in the C code break the 80columns limit.
** DONE please use ANSI style function declarations rather than K&R for new code. ([[2010.06.14]])
** DONE you can get rid of the prototypes by reordering the code. ([[2010.06.14]])
** DONE the docstrings in DEFUN should not be indented (they'll display ([[2010.06.14]])
weirdly otherwise in C-h f).
** DONE Some "{" are at the end of a for/if rather than on their own line. ([[2010.06.14]])
** DONE why use "*( imtypes + i)" rather than "imtypes[i]"? ([[2010.06.14]])
** DONE some "," lack a space after them. ([[2010.06.14]])
** DONE several "=" and "==" lack spaces around them. ([[2010.06.14]])
* NEWS entry
** ImageMagick support
It is now possible to use the Imagemagick library to load many new
image formats in Emacs.
To enable, use the following configure option:
--with-imagemagick
The new function (imagemagick-types) returns a list of image file
extensions that your installation of imagemagick supports.
The function (imagemagick-register-types) will enable the imagemagick
support for the extensions in imagemagick-types minus the types listed
in imagemagick-types-inhibit.
imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by default.
This means imagemagick will be used also to load jpeg files, if you
have both jpeg and imagemagick libraries linked. Add 'JPG to
imagemagick-types-inhibit if you do not want this.
imagemagick-render-type is a new variable which can be set to choose
between screen render methods.
- 0 is a conservative metod which works with older ImageMagick
versions. It is a bit slow, but robust.
- 1 utilizes a newer ImageMagick method
Images loaded with imagemagick will support a couple of new display
specification behaviours:
- if the :width and :height keywords are specified, these values are
used for scaling the image. If only one of :width or :height is
specified, the other one will be calculated so as to preserve the
aspect ratio.If both :width and :height are specified, aspect ratio
will not be preserved.
- :rotation specifies a rotation angle in degrees.
- :index specifies which image inside an image bundle file format, such
as TIFF or DJVM, to view.
The image-metadata function can be used to retrieve the total number
of images in an image bundle. This is simmilar to how GIF files work.
* Manual entry
nothing yet, but the NEWS entry could be adapted.

2
admin/unidata/Makefile.in
View File

@ -21,7 +21,7 @@
EMACS = ../../src/emacs
DSTDIR = ../../lisp/international
RUNEMACS = ${EMACS} -Q --multibyte -batch
RUNEMACS = ${EMACS} -Q -batch
all: ${DSTDIR}/charprop.el ../../src/biditype.h ../../src/bidimirror.h

2
admin/unidata/makefile.w32-in
View File

@ -27,7 +27,7 @@ lisp = $(CURDIR)/../../lisp
# lisp/subdirs.el is not generated yet when the commands below run.
EMACSLOADPATH = $(lisp);$(lisp)/international;$(lisp)/emacs-lisp
# Quote EMACS so it could be a file name with embedded whitespace
RUNEMACS = "$(EMACS)" -Q --multibyte -batch
RUNEMACS = "$(EMACS)" -Q -batch
all: $(DSTDIR)/charprop.el ../../src/biditype.h ../../src/bidimirror.h

548
configure vendored
View File

File diff suppressed because it is too large Load Diff

22
configure.in
View File

@ -155,6 +155,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support])
OPTION_DEFAULT_ON([gif],[don't compile with GIF image support])
OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support])
OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
@ -1824,12 +1825,11 @@ if test "${HAVE_X11}" = "yes" || test "${NS_IMPL_GNUSTEP}" = "yes"; then
RSVG_REQUIRED=2.11.0
RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED"
PKG_CHECK_MODULES(RSVG, $RSVG_MODULE, :, :)
PKG_CHECK_MODULES(RSVG, $RSVG_MODULE, HAVE_RSVG=yes, :)
AC_SUBST(RSVG_CFLAGS)
AC_SUBST(RSVG_LIBS)
if test ".${RSVG_CFLAGS}" != "."; then
HAVE_RSVG=yes
if test $HAVE_RSVG = yes; then
AC_DEFINE(HAVE_RSVG, 1, [Define to 1 if using librsvg.])
CFLAGS="$CFLAGS $RSVG_CFLAGS"
LIBS="$RSVG_LIBS $LIBS"
@ -1837,6 +1837,21 @@ if test "${HAVE_X11}" = "yes" || test "${NS_IMPL_GNUSTEP}" = "yes"; then
fi
fi
HAVE_IMAGEMAGICK=no
if test "${with_imagemagick}" != "no"; then
IMAGEMAGICK_MODULE="Wand"
PKG_CHECK_MODULES(IMAGEMAGICK, $IMAGEMAGICK_MODULE, HAVE_IMAGEMAGICK=yes, :)
AC_SUBST(IMAGEMAGICK_CFLAGS)
AC_SUBST(IMAGEMAGICK_LIBS)
if test $HAVE_IMAGEMAGICK = yes; then
AC_DEFINE(HAVE_IMAGEMAGICK, 1, [Define to 1 if using imagemagick.])
CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
LIBS="$IMAGEMAGICK_LIBS $LIBS"
AC_CHECK_FUNCS(MagickExportImagePixels)
fi
fi
HAVE_GTK=no
if test "${with_gtk3}" = "yes"; then
@ -3662,6 +3677,7 @@ echo " Does Emacs use -ltiff? ${HAVE_TIFF}"
echo " Does Emacs use a gif library? ${HAVE_GIF} $LIBGIF"
echo " Does Emacs use -lpng? ${HAVE_PNG}"
echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}"
echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}"
echo " Does Emacs use -lgpm? ${HAVE_GPM}"
echo " Does Emacs use -ldbus? ${HAVE_DBUS}"
echo " Does Emacs use -lgconf? ${HAVE_GCONF}"

4
doc/emacs/ChangeLog
View File

@ -1,3 +1,7 @@
2010-08-21 Glenn Morris <rgm@gnu.org>
* misc.texi (Amusements): Mention bubbles and animate.
2010-07-31 Eli Zaretskii <eliz@gnu.org>
* files.texi (Visiting): Add more index entries for

9
doc/emacs/misc.texi
View File

@ -2784,6 +2784,10 @@ bored, try an argument of 9. Sit back and watch.
If you want a little more personal involvement, try @kbd{M-x gomoku},
which plays the game Go Moku with you.
@findex bubbles
@kbd{M-x bubbles} is a game in which the object is to remove as many
bubbles as you can in the smallest number of moves.
@findex blackbox
@findex mpuz
@findex 5x5
@ -2832,6 +2836,11 @@ bats.
@kbd{M-x solitaire} plays a game of solitaire in which you jump pegs
across other pegs.
@findex animate-birthday-present
@cindex animate
The @code{animate} package makes text dance. For an example, try
@kbd{M-x animate-birthday-present}.
@findex studlify-region
@cindex StudlyCaps
@kbd{M-x studlify-region} studlify-cases the region, producing

26
doc/lispref/ChangeLog
View File

@ -1,3 +1,29 @@
2010-08-24 Markus Triska <triska@gmx.at>
* processes.texi (Filter Functions): Use `buffer-live-p' instead
of `buffer-name' in the main text as well as in the example
(Bug#3098).
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* nonascii.texi (Text Representations):
* loading.texi (Loading Non-ASCII):
* compile.texi (Byte Compilation): Don't mention obsolete
--unibyte command-line argument.
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* modes.texi (Defining Minor Modes): Doc fix (Bug#6880).
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* objects.texi (Bool-Vector Type): Minor definition tweak (Bug#6878).
2010-08-20 Eli Zaretskii <eliz@gnu.org>
* commands.texi (Misc Events): Add cross-references to where
POSITION of a mouse event is described in detail.
2010-08-08 Christoph <cschol2112@googlemail.com>
* control.texi (Handling Errors) <error-message-string>: Fix arg name.

10
doc/lispref/commands.texi
View File

@ -1616,7 +1616,8 @@ These kinds of event are generated by moving a mouse wheel. Their
usual meaning is a kind of scroll or zoom.
The element @var{position} is a list describing the position of the
event, in the same format as used in a mouse-click event.
event, in the same format as used in a mouse-click event (@pxref{Click
Events}).
@vindex mouse-wheel-up-event
@vindex mouse-wheel-down-event
@ -1633,9 +1634,10 @@ selected in an application outside of Emacs, and then dragged and
dropped onto an Emacs frame.
The element @var{position} is a list describing the position of the
event, in the same format as used in a mouse-click event, and
@var{files} is the list of file names that were dragged and dropped.
The usual way to handle this event is by visiting these files.
event, in the same format as used in a mouse-click event (@pxref{Click
Events}), and @var{files} is the list of file names that were dragged
and dropped. The usual way to handle this event is by visiting these
files.
This kind of event is generated, at present, only on some kinds of
systems.

6
doc/lispref/compile.texi
View File

@ -22,12 +22,6 @@ hardware (as true compiled code is), byte-code is completely
transportable from machine to machine without recompilation. It is not,
however, as fast as true compiled code.
Compiling a Lisp file with the Emacs byte compiler always reads the
file as multibyte text, even if Emacs was started with @samp{--unibyte},
unless the file specifies otherwise. This is so that compilation gives
results compatible with running the same file without compilation.
@xref{Loading Non-ASCII}.
In general, any version of Emacs can run byte-compiled code produced
by recent earlier versions of Emacs, but the reverse is not true.

46
doc/lispref/display.texi
View File

@ -4039,6 +4039,7 @@ displayed (@pxref{Display Feature Testing}).
* GIF Images:: Special features for GIF format.
* TIFF Images:: Special features for TIFF format.
* PostScript Images:: Special features for PostScript format.
* ImageMagick Images:: Special features available through ImageMagick.
* Other Image Types:: Various other formats are supported.
* Defining Images:: Convenient ways to define an image for later use.
* Showing Images:: Convenient ways to display an image once it is defined.
@ -4463,6 +4464,51 @@ specifying the bounding box of the PostScript image, analogous to the
@end example
@end table
@node ImageMagick Images
@subsection ImageMagick Images
The Imagemagick library can be used to load many image formats in Emacs.
The function (imagemagick-types) returns a list of image file
extensions that your installation of imagemagick supports.
The function (imagemagick-register-types) will enable the imagemagick
support for the extensions in imagemagick-types minus the types listed
in imagemagick-types-inhibit.
imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by
default. There can be overlap between image loaders in your Emacs
installation. If you never want to use the ImageMagick loader to use
Jpeg files, for instance, add 'JPG to imagemagick-types-inhibit. Which
loader that will be used in practice depends on the priority of the
loaders.
imagemagick-render-type is a new variable which can be set to choose
between screen render methods for the ImageMagick loader.
- 0 is a conservative metod which works with older ImageMagick
versions. It is a bit slow, but robust.
- 1 utilizes a newer ImageMagick method
Images loaded with imagemagick will support a couple of new display
specification behaviours:
- if the :width and :height keywords are specified, these values are
used for scaling the image. If only one of :width or :height is
specified, the other one will be calculated so as to preserve the
aspect ratio.If both :width and :height are specified, aspect ratio
will not be preserved.
- :rotation specifies a rotation angle in degrees.
- :index specifies which image inside an image bundle file format, such
as TIFF or DJVM, to view.
The image-metadata function can be used to retrieve the total number
of images in an image bundle. This is simmilar to how GIF files work.
@node Other Image Types
@subsection Other Image Types
@cindex PBM

7
doc/lispref/loading.texi
View File

@ -367,13 +367,6 @@ example) is read without decoding, the text of the program will be
unibyte text, and its string constants will be unibyte strings.
@xref{Coding Systems}.
To make the results more predictable, Emacs always performs decoding
into the multibyte representation when loading Lisp files, even if it
was started with the @samp{--unibyte} option. This means that string
constants with non-@acronym{ASCII} characters translate into multibyte
strings. The only exception is when a particular file specifies no
decoding.
The reason Emacs is designed this way is so that Lisp programs give
predictable results, regardless of how Emacs was started. In addition,
this enables programs that depend on using multibyte text to work even

12
doc/lispref/modes.texi
View File

@ -1411,14 +1411,20 @@ The string @var{lighter} says what to display in the mode line
when the mode is enabled; if it is @code{nil}, the mode is not displayed
in the mode line.
The optional argument @var{keymap} specifies the keymap for the minor mode.
It can be a variable name, whose value is the keymap, or it can be an alist
specifying bindings in this form:
The optional argument @var{keymap} specifies the keymap for the minor
mode. If non-@code{nil}, it should be a variable name (whose value is
a keymap), a keymap, or an alist of the form
@example
(@var{key-sequence} . @var{definition})
@end example
@noindent
where each @var{key-sequence} and @var{definition} are arguments
suitable for passing to @code{define-key} (@pxref{Changing Key
Bindings}). If @var{keymap} is a keymap or an alist, this also
defines the variable @code{@var{mode}-map}.
The above three arguments @var{init-value}, @var{lighter}, and
@var{keymap} can be (partially) omitted when @var{keyword-args} are
used. The @var{keyword-args} consist of keywords followed by

3
doc/lispref/nonascii.texi
View File

@ -102,9 +102,6 @@ it contains unibyte encoded text or binary non-text data.
You cannot set this variable directly; instead, use the function
@code{set-buffer-multibyte} to change a buffer's representation.
The @samp{--unibyte} command line option does its job by setting the
default value to @code{nil} early in startup.
@end defvar
@defun position-bytes position

4
doc/lispref/objects.texi
View File

@ -1189,8 +1189,8 @@ Syntax tables (@pxref{Syntax Tables}).
@node Bool-Vector Type
@subsection Bool-Vector Type
A @dfn{bool-vector} is a one-dimensional array of elements that
must be @code{t} or @code{nil}.
A @dfn{bool-vector} is a one-dimensional array whose elements must
be @code{t} or @code{nil}.
The printed representation of a bool-vector is like a string, except
that it begins with @samp{#&} followed by the length. The string

28
doc/lispref/processes.texi
View File

@ -1273,22 +1273,24 @@ process's buffer, mimicking the actions of Emacs when there is no
filter. Such filter functions need to use @code{set-buffer} in order to
be sure to insert in that buffer. To avoid setting the current buffer
semipermanently, these filter functions must save and restore the
current buffer. They should also update the process marker, and in some
cases update the value of point. Here is how to do these things:
current buffer. They should also check whether the buffer is still
alive, update the process marker, and in some cases update the value
of point. Here is how to do these things:
@smallexample
@group
(defun ordinary-insertion-filter (proc string)
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
@end group
@group
(save-excursion
;; @r{Insert the text, advancing the process marker.}
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc))))))
(save-excursion
;; <at> r{Insert the text, advancing the process marker.}
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc)))))))
@end group
@end smallexample
@ -1315,12 +1317,6 @@ expression searching or matching had to explicitly save and restore the
match data. Now Emacs does this automatically for filter functions;
they never need to do it explicitly. @xref{Match Data}.
A filter function that writes the output into the buffer of the
process should check whether the buffer is still alive. If it tries to
insert into a dead buffer, it will get an error. The expression
@code{(buffer-name (process-buffer @var{process}))} returns @code{nil}
if the buffer is dead.
The output to the function may come in chunks of any size. A program
that produces the same output twice in a row may send it as one batch of
200 characters one time, and five batches of 40 characters the next. If

4
doc/misc/ChangeLog
View File

@ -1,3 +1,7 @@
2010-08-23 Michael Albinus <michael.albinus@gmx.de>
* dbus.texi (Alternative Buses): New chapter.
2010-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
* cl.texi (Mapping over Sequences): Rename mapc => cl-mapc.

51
doc/misc/dbus.texi
View File

@ -53,6 +53,7 @@ another. An overview of D-Bus can be found at
* Asynchronous Methods:: Calling methods non-blocking.
* Receiving Method Calls:: Offering own methods.
* Signals:: Sending and receiving signals.
* Alternative Buses:: Alternative buses.
* Errors and Events:: Errors and events.
* Index:: Index including concepts, functions, variables.
@ -1579,6 +1580,56 @@ which objects the GNU/Linux @code{hal} daemon adds.
@end defun
@node Alternative Buses
@chapter Alternative buses.
@cindex bus names
@cindex UNIX domain socket
Until now, we have spoken about the system and the session buses,
which are the default buses to be connected to. However, it is
possible to connect to any bus, from which the address is known. This
is a UNIX domain socket. Everywhere, where a @var{bus} is mentioned
as argument of a function (the symbol @code{:system} or the symbol
@code{:session}), this address can be used instead. The connection to
this bus must be initialized first.
@defun dbus-init-bus bus
Establish the connection to D-Bus @var{bus}.
@var{bus} can be either the symbol @code{:system} or the symbol
@code{:session}, or it can be a string denoting the address of the
corresponding bus. For the system and session busses, this function
is called when loading @file{dbus.el}, there is no need to call it
again.
Example: You open another session bus in a terminal window on your host:
@example
# eval `dbus-launch --auto-syntax`
# echo $DBUS_SESSION_BUS_ADDRESS
@print{} unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e
@end example
In Emacs, you can access to this bus via its address:
@lisp
(setq my-bus
"unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e")
@result{} "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e"
(dbus-init-bus my-bus)
@result{} nil
(dbus-get-unique-name my-bus)
@result{} ":1.0"
@end lisp
@end defun
@node Errors and Events
@chapter Errors and events.
@cindex debugging

4
etc/ChangeLog
View File

@ -2,6 +2,10 @@
* HELLO: Change designation sequences for Arabic text.
2010-08-23 Michael Albinus <michael.albinus@gmx.de>
* NEWS: dbus.el supports alternative buses.
2010-08-14 Eli Zaretskii <eliz@gnu.org>
* tutorials/TUTORIAL.he: Use MAQAF instead of hyphen where appropriate.

27
etc/NEWS
View File

@ -59,6 +59,10 @@ automatically select it.
* Startup Changes in Emacs 24.1
** The --unibyte, --multibyte, --no-multibyte, and --no-unibyte
command line arguments no longer have any effect. (They were declared
obsolete in Emacs 23.)
* Changes in Emacs 24.1
@ -109,6 +113,22 @@ The frame-parameter tool-bar-position controls this. It takes the values
top, left, right or bottom. The Options => Show/Hide menu has entries
for this.
** ImageMagick support
It is now possible to use the Imagemagick library to load many new
image formats in Emacs.
To enable, use the following configure option:
--with-imagemagick
The new function (imagemagick-types) returns a list of image file
extensions that your installation of imagemagick supports.
The function (imagemagick-register-types) will enable the imagemagick
support for the extensions in imagemagick-types minus the types listed
in imagemagick-types-inhibit.
See the Emacs Manual for more information.
** The colors for selected text (the region face) are taken from the GTK
theme when Emacs is built with GTK.
@ -393,6 +413,11 @@ enabled by default in 23.1.
supports multithread non-stop debugging and debugging of several
threads simultaneously.
** D-Bus
*** It is possible now, to access alternative buses than the default
system or session bus.
* New Modes and Packages in Emacs 24.1
@ -437,6 +462,8 @@ has now been removed.
* Lisp changes in Emacs 24.1
** New hook post-self-insert-hook run at the end of self-insert-command.
** Syntax tables support a new "comment style c" additionally to style b.
** frame-local variables cannot be let-bound any more.
** prog-mode is a new major-mode meant to be the parent of programming mode.

23
leim/ChangeLog
View File

@ -1,3 +1,26 @@
2010-08-15 Andreas Schwab <schwab@linux-m68k.org>
* quail/vntelex.el ("vietnamese-telex"): Doc fix.
* quail/georgian.el: Remove extra backslashes.
2010-08-14 Andreas Schwab <schwab@linux-m68k.org>
* quail/arabic.el: Quote [ and ].
* quail/latin-ltx.el: Likewise.
* quail/greek.el ("greek", "greek-postfix"): Change string to
character.
2010-08-13 Kenichi Handa <handa@m17n.org>
* quail/greek.el ("greek-postfix"): Add rules for Greek style
quotes.
2010-08-09 Kenichi Handa <handa@m17n.org>
* quail/greek.el ("greek"): Add rules for Greek style quotes.
2010-05-15 Glenn Morris <rgm@gnu.org>
* Makefile.in (install): Remove references to CVS-related files.

2
leim/Makefile.in
View File

@ -48,7 +48,7 @@ buildlisppath=${srcdir}/../lisp
# How to run Emacs.
RUN-EMACS = EMACSLOADPATH=$(buildlisppath) LC_ALL=C \
${BUILT-EMACS} -batch --no-init-file --no-site-file --multibyte
${BUILT-EMACS} -batch --no-init-file --no-site-file
# Subdirectories to be made if ${srcdir} is different from the current
# directory.

2
leim/makefile.w32-in
View File

@ -37,7 +37,7 @@ BUILT_EMACS = $(THISDIR)/$(dot)$(dot)/src/$(BLD)/emacs.exe
buildlisppath=$(CURDIR)/$(dot)$(dot)/lisp
# How to run Emacs.
RUN_EMACS = "$(BUILT_EMACS)" -batch --no-init-file --no-site-file --multibyte
RUN_EMACS = "$(BUILT_EMACS)" -batch --no-init-file --no-site-file
# Set EMACSLOADPATH correctly (already defined in environment).
EMACSLOADPATH=$(buildlisppath)

4
leim/quail/arabic.el
View File

@ -57,8 +57,8 @@ Based on Arabic table in X Keyboard Configuration DB.
("A" ?ِ)
("S" ?ٍ)
("D" ?])
("F" ?[)
("D" ?\])
("F" ?\[)
("G" ["لأ"])
("H" ?أ)
("J" ?ـ)

10
leim/quail/georgian.el
View File

@ -51,7 +51,7 @@
("n" ?ნ)
("o" ?ო)
(".p" ?პ)
("\+z" ?ჟ)
("+z" ?ჟ)
("r" ?რ)
("s" ?ს)
(".t" ?ტ)
@ -60,14 +60,14 @@
("k" ?ქ)
(".g" ?ღ)
("q" ?ყ)
("\+s" ?შ)
("\+c" ?ჩ)
("+s" ?შ)
("+c" ?ჩ)
("c" ?ც)
("j" ?ძ)
(".c" ?წ)
(".\+c" ?ჭ)
(".+c" ?ჭ)
("x" ?ხ)
("\+j" ?ჯ)
("+j" ?ჯ)
("h" ?ჰ)
("q1" ?ჴ)
("e0" ?ჱ)

11
leim/quail/greek.el
View File

@ -1279,7 +1279,9 @@ e.g.
(";:i" ?,F@(B)
(":;i" ?,F@(B)
(";:y" ?,F`(B)
(":;y" ?,F`(B))
(":;y" ?,F`(B)
(";<" ?$(Q)((B)
(";>" ?$(Q)2(B))
(quail-define-package
"greek-postfix" "GreekPost" ",FX(B" nil
@ -1419,7 +1421,12 @@ e.g.
("i:;" ?,F@(B)
("i;:" ?,F@(B)
("y:;" ?,F`(B)
("y;:" ?,F`(B))
("y;:" ?,F`(B)
;; These two are asymmetric with ";<" and ";>" in "greek" input
;; method. But, as the other Latin postfix methods adopt "<<" and
;; ">>", it may be better to follow them.
("<<" ?$(Q)((B)
(">>" ?$(Q)2(B))
;; arch-tag: 2a37e042-db1b-4ecf-b755-117775a3c150

4
leim/quail/latin-ltx.el
View File

@ -653,7 +653,7 @@ system, including many technical ones. Examples:
("\\lambda" ?λ)
("\\langle" ?〈)
("\\lbrace" ?{)
("\\lbrack" ?[)
("\\lbrack" ?\[)
("\\lceil" ?⌈)
("\\ldots" ?…)
("\\le" ?≤)
@ -788,7 +788,7 @@ system, including many technical ones. Examples:
("\\quad" ? )
("\\rangle" ?〉)
("\\rbrace" ?})
("\\rbrack" ?])
("\\rbrack" ?\])
("\\rceil" ?⌉)
("\\rfloor" ?⌋)
("\\rightarrow" ?→)

2
leim/quail/vntelex.el
View File

@ -53,7 +53,7 @@ Other diacritics:
acute s as -> ,1a(B
grave f af -> ,1`(B
hook above r ar -> ,1d(B
tilde x ax -> ,1c(B
tilde x ax -> ,1c(B
dot below j aj -> ,1U(B
d bar dd -> ,1p(B

230
lisp/ChangeLog
View File

@ -6,6 +6,205 @@
* international/fontset.el (setup-default-fontset): Fix typo for
arabic OTF spec (fini->fina).
2010-08-24 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* whitespace.el: Allow cleaning up blanks without blank
visualization (Bug#6651). Adjust help window for
whitespace-toggle-options (Bug#6479). Allow to use fill-column
instead of whitespace-line-column (from EmacsWiki). New version
13.1.
(whitespace-style): Added new value 'face. Adjust docstring.
(whitespace-space, whitespace-hspace, whitespace-tab): Adjust
foreground property face.
(whitespace-line-column): Adjust docstring and type declaration.
(whitespace-style-value-list, whitespace-toggle-option-alist)
(whitespace-help-text): Adjust const initialization.
(whitespace-toggle-options, global-whitespace-toggle-options):
Adjust docstring.
(whitespace-display-window, whitespace-interactive-char)
(whitespace-style-face-p, whitespace-color-on): Adjust code.
(whitespace-help-scroll): New fun.
2010-08-24 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/package.el (list-packages): Alias for
package-list-packages.
2010-08-24 Kevin Ryde <user42@zip.com.au>
* textmodes/flyspell.el (flyspell-check-tex-math-command): Doc fix
(Bug#5651).
* progmodes/ruby-mode.el (ruby): Add defgroup.
2010-08-24 Chong Yidong <cyd@stupidchicken.com>
* progmodes/python.el: Add Ipython support (Bug#5390).
(python-shell-prompt-alist)
(python-shell-continuation-prompt-alist): New options.
(python--set-prompt-regexp): New function.
(inferior-python-mode, run-python, python-shell): Require
ansi-color. Use python--set-prompt-regexp to set the comint
prompt based on the Python interpreter.
(python--prompt-regexp): New var.
(python-check-comint-prompt)
(python-comint-output-filter-function): Use it.
(run-python): Use a pipe (Bug#5694).
2010-08-24 Fabian Ezequiel Gallina <galli.87@gmail.com> (tiny change)
* progmodes/python.el (python-send-region): Send a different
Python command if Ipython is in use.
(python-check-version): Use a Python command to find the version.
2010-08-24 Chong Yidong <cyd@stupidchicken.com>
* mouse.el (mouse-yank-primary): Avoid setting primary when
deactivating the mark (Bug#6872).
2010-08-23 Michael Albinus <michael.albinus@gmx.de>
* net/dbus.el: Accept UNIX domain sockets as bus address.
(top): Don't initialize `dbus-registered-objects-table' anymore,
this is done in dbusbind,c.
(dbus-check-event): Adapt test for bus.
(dbus-return-values-table, dbus-unregister-service)
(dbus-event-bus-name, dbus-introspect, dbus-register-property):
Adapt doc string.
2010-08-23 Juanma Barranquero <lekktu@gmail.com>
* ido.el (ido-use-virtual-buffers): Fix typo in docstring.
2010-08-22 Juri Linkov <juri@jurta.org>
* simple.el (read-extended-command): New function with the logic
for `completing-read' moved to Elisp from `execute-extended-command'.
Use `function-called-at-point' in `minibuffer-default-add-function'
to get a command name for M-n (bug#5364, bug#5214).
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* startup.el (command-line-1): Issue warning for ignored arguments
--unibyte, etc (Bug#6886).
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix (Bug#6880).
2010-08-22 Leo <sdl.web@gmail.com>
Fix buffer-list rename&refresh after after killing a buffer in ido.
* lisp/ido.el: Revert Óscar's.
(ido-kill-buffer-at-head): Exit the minibuffer with ido-exit=refresh.
Remember the buffers at head, rather than their name.
* lisp/iswitchb.el (iswitchb-kill-buffer): Re-make the list.
2010-08-22 Kirk Kelsey <kirk.kelsey@0x4b.net> (tiny change)
Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/make-mode.el (makefile-fill-paragraph): Account for the
extra backslash added to each line (bug#6890).
2010-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (read-key): Don't echo keystrokes (bug#6883).
2010-08-22 Glenn Morris <rgm@gnu.org>
* menu-bar.el (menu-bar-games-menu): Add landmark.
2010-08-22 Glenn Morris <rgm@gnu.org>
* align.el (align-regexp): Make group and spacing arguments
use the interactive defaults when non-interactive. (Bug#6698)
* mail/rmail.el (rmail-forward): Replace mail-text-start with its
expansion, so as not to need sendmail.
(mail-text-start): Remove declaration.
(rmail-retry-failure): Require sendmail.
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* subr.el (read-key): Don't hide the menu-bar entries (bug#6881).
2010-08-22 Michael Albinus <michael.albinus@gmx.de>
* progmodes/flymake.el (flymake-start-syntax-check-process):
Use `start-file-process' in order to let it run also on remote hosts.
2010-08-22 Kenichi Handa <handa@m17n.org>
* files.el: Add `word-wrap' as safe local variable.
2010-08-22 Glenn Morris <rgm@gnu.org>
* woman.el (woman-translate): Case matters. (Bug#6849)
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* simple.el (kill-region): Doc fix (Bug#6787).
2010-08-22 Glenn Morris <rgm@gnu.org>
* calendar/diary-lib.el (diary-header-line-format):
Fit it to the window, not the frame.
2010-08-22 Andreas Schwab <schwab@linux-m68k.org>
* subr.el (ignore-errors): Add debug declaration.
2010-08-22 Geoff Gole <geoffgole@gmail.com> (tiny change)
* whitespace.el (whitespace-color-off): Remove post-command-hook
locally.
2010-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
* vc/add-log.el (add-log-file-name): Don't get confused by symlinks.
2010-08-21 Chong Yidong <cyd@stupidchicken.com>
* cus-edit.el (custom-group-value-create): Add extra newline
before end line (Bug#6876).
2010-08-21 Chong Yidong <cyd@stupidchicken.com>
* mouse.el (mouse-save-then-kill): Don't save region to kill ring
when extending it. Before killing on the second click, check if
the buffer is the correct one. Doc fix.
(mouse-secondary-save-then-kill): Allow usage without first
calling mouse-start-secondary, by defaulting to point. Don't save
an empty secondary selection. Doc fix.
2010-08-21 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* whitespace.el: Fix slow cursor movement (Bug#6172). Reported by
Christoph Groth <cwg@falma.de> and Liu Xin <x_liu@neusoft.com>.
New version 13.0.
(whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp):
Adjust initialization.
(whitespace-bob-marker, whitespace-eob-marker)
(whitespace-buffer-changed): New vars.
(whitespace-cleanup, whitespace-color-on, whitespace-color-off)
(whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp)
(whitespace-post-command-hook, whitespace-display-char-on):
Adjust code.
(whitespace-looking-back, whitespace-buffer-changed): New funs.
(whitespace-space-regexp, whitespace-tab-regexp): Fun eliminated.
2010-08-19 Stefan Monnier <monnier@iro.umontreal.ca>
* files.el (locate-file-completion-table): Only list the .el and .elc
extensions if there's no other choice (bug#5955).
* facemenu.el (facemenu-self-insert-data): New var.
(facemenu-post-self-insert-function, facemenu-set-self-insert-face):
New functions.
(facemenu-add-face): Use them.
* simple.el (blink-matching-open): Obey forward-sexp-function.
2010-08-18 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (prog-mode-map): New var.
@ -34,6 +233,17 @@
* emacs-lisp/autoload.el (make-autoload): Preload the macros's
declarations that are useful before running the macro.
2010-08-18 Joakim Verona <joakim@verona.se>
* image.el (imagemagick-types-inhibit): New variable.
(imagemagick-register-types): New function.
* image-mode.el (image-transform-properties): New function.
(image-transform-set-scale, image-transform-fit-to-height)
(image-transform-set-rotation, image-transform-set-resize)
(image-transform-fit-to-width, image-transform-fit-to-height):
New functions.
(image-toggle-display-image): Support image transforms.
2010-08-18 Katsumi Yamaoka <yamaoka@jpl.org>
* image.el (create-animated-image): Don't add heuristic mask to image
@ -297,7 +507,7 @@
(ctext-standard-encodings): New variable.
(ctext-non-standard-encodings-table): List only elements for
non-standard encodings.
(ctext-pre-write-conversion): Adjusted for the above change.
(ctext-pre-write-conversion): Adjust for the above change.
Check ctext-standard-encodings.
* international/mule-conf.el (compound-text): Doc fix.
@ -3186,7 +3396,8 @@
* minibuffer.el (tags-completion-at-point-function): New function.
(completion-at-point-functions): Use it.
* cedet/semantic.el (semantic-completion-at-point-function): New function.
* cedet/semantic.el (semantic-completion-at-point-function):
New function.
(semantic-mode): Use semantic-completion-at-point-function for
completion-at-point-functions instead.
@ -3236,8 +3447,8 @@
2010-04-28 Chong Yidong <cyd@stupidchicken.com>
* progmodes/bug-reference.el (bug-reference-url-format): Revert
2010-04-27 change due to security risk.
* progmodes/bug-reference.el (bug-reference-url-format):
Revert 2010-04-27 change due to security risk.
2010-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
@ -3412,8 +3623,7 @@
* ido.el (ido-init-completion-maps): For ido-switch-buffer, C-o
toggles the use of virtual buffers.
(ido-buffer-internal): Guard `ido-use-virtual-buffers' global
value.
(ido-buffer-internal): Guard `ido-use-virtual-buffers' global value.
(ido-toggle-virtual-buffers): New function.
2010-04-21 Juanma Barranquero <lekktu@gmail.com>
@ -3990,7 +4200,7 @@
Enable recentf-mode if using virtual buffers.
* ido.el (recentf-list): Declare for byte-compiler.
(ido-virtual-buffers): Move up to silence byte-compiler. Add docstring.
(ido-virtual-buffers): Move up to silence byte-compiler. Add docstring.
(ido-make-buffer-list): Simplify.
(ido-add-virtual-buffers-to-list): Simplify. Enable recentf-mode.
@ -5501,8 +5711,8 @@
2010-01-21 Alan Mackenzie <acm@muc.de>
Fix a situation where deletion of a cpp construct throws an error.
* progmodes/cc-engine.el (c-invalidate-state-cache): Before
invoking c-with-all-but-one-cpps-commented-out, check that the
* progmodes/cc-engine.el (c-invalidate-state-cache):
Before invoking c-with-all-but-one-cpps-commented-out, check that the
special cpp construct is still in the buffer.
(c-parse-state): Record the special cpp with markers, not numbers.
@ -6229,7 +6439,7 @@
* ps-print.el (ps-face-attributes): It was not returning the
attribute face for faces specified as string. Reported by harven
<harven@free.fr>.
<harven@free.fr>. (Bug#5254)
(ps-print-version): New version 7.3.5.
2009-12-18 Ulf Jasper <ulf.jasper@web.de>

5
lisp/Makefile.in
View File

@ -33,10 +33,9 @@ VPATH = $(srcdir)
# to use an absolute file name.
EMACS = ${abs_top_builddir}/src/emacs
# Command line flags for Emacs. This must include --multibyte,
# otherwise some files will not compile.
# Command line flags for Emacs.
EMACSOPT = -batch --no-site-file --multibyte
EMACSOPT = -batch --no-site-file
# Extra flags to pass to the byte compiler
BYTE_COMPILE_EXTRA_FLAGS =

6
lisp/align.el
View File

@ -1,7 +1,7 @@
;;; align.el --- align text to a specific column, by regexp
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: FSF
@ -944,6 +944,8 @@ region, call `align-regexp' and type in that regular expression."
(list (concat "\\(\\s-*\\)"
(read-string "Align regexp: "))
1 align-default-spacing nil))))
(or group (setq group 1))
(or spacing (setq spacing align-default-spacing))
(let ((rule
(list (list nil (cons 'regexp regexp)
(cons 'group (abs group))

4
lisp/calendar/diary-lib.el
View File

@ -383,14 +383,14 @@ The format of the header is specified by `diary-header-line-format'."
"Some text is hidden - press \"s\" in calendar \
before edit/copy"
"Diary"))
?\s (frame-width)))
?\s (window-width)))
"Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
:initialize 'custom-initialize-default
:set 'diary-set-header
:version "22.1")
:version "23.3") ; frame-width -> window-width
;; The first version of this also checked for diary-selective-display
;; in the non-fancy case. This was an attempt to distinguish between

4
lisp/cus-edit.el
View File

@ -4097,8 +4097,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
(custom-group-state-update widget)
(progress-reporter-done reporter))
;; End line
(let ((p (point)))
(insert "\n")
(let ((p (1+ (point))))
(insert "\n\n")
(put-text-property p (1+ p) 'face '(:underline t))
(overlay-put (make-overlay p (1+ p))
'before-string

28
lisp/emacs-lisp/easy-mmode.el
View File

@ -86,25 +86,23 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
"Define a new minor mode MODE.
This function defines the associated control variable MODE, keymap MODE-map,
and toggle command MODE.
This defines the control variable MODE and the toggle command MODE.
DOC is the documentation for the mode toggle command.
Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the modeline when the mode is on.
Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
If it is a list, it is passed to `easy-mmode-define-keymap'
in order to build a valid keymap. It's generally better to use
a separate MODE-map variable than to use this argument.
The above three arguments can be skipped if keyword arguments are
used (see below).
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
a keymap, or a list of arguments for `easy-mmode-define-keymap'.
If KEYMAP is a keymap or list, this also defines the variable MODE-map.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
alternating keywords and values. These following special keywords
are supported (other keywords are passed to `defcustom' if the minor
mode is global):
BODY contains code to execute each time the mode is activated or deactivated.
It is executed after toggling the mode,
and before running the hook variable `MODE-hook'.
Before the actual body code, you can write keyword arguments (alternating
keywords and values). These following keyword arguments are supported (other
keywords will be passed to `defcustom' if the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
Defaults to MODE without the possible trailing \"-mode\".
Don't use this default group name unless you have written a

3
lisp/emacs-lisp/package.el
View File

@ -1557,6 +1557,9 @@ The list is displayed in a buffer named `*Packages*'."
(package-refresh-contents)
(package--list-packages))
;;;###autoload
(defalias 'list-packages 'package-list-packages)
(defun package-list-packages-no-fetch ()
"Display a list of packages.
Does not fetch the updated list of packages before displaying.

105
lisp/facemenu.el
View File

@ -699,6 +699,22 @@ determine the correct answer."
(cond ((equal a b) t)
((equal (color-values a) (color-values b)))))
(defvar facemenu-self-insert-data nil)
(defun facemenu-post-self-insert-function ()
(when (and (car facemenu-self-insert-data)
(eq last-command (cdr facemenu-self-insert-data)))
(put-text-property (1- (point)) (point)
'face (car facemenu-self-insert-data))
(setq facemenu-self-insert-data nil))
(remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function))
(defun facemenu-set-self-insert-face (face)
"Arrange for the next self-inserted char to have face `face'."
(setq facemenu-self-insert-data (cons face this-command))
(add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function))
(defun facemenu-add-face (face &optional start end)
"Add FACE to text between START and END.
If START is nil or START to END is empty, add FACE to next typed character
@ -712,51 +728,52 @@ As a special case, if FACE is `default', then the region is left with NO face
text property. Otherwise, selecting the default face would not have any
effect. See `facemenu-remove-face-function'."
(interactive "*xFace: \nr")
(if (and (eq face 'default)
(not (eq facemenu-remove-face-function t)))
(if facemenu-remove-face-function
(funcall facemenu-remove-face-function start end)
(if (and start (< start end))
(remove-text-properties start end '(face default))
(setq self-insert-face 'default
self-insert-face-command this-command)))
(if facemenu-add-face-function
(save-excursion
(if end (goto-char end))
(save-excursion
(if start (goto-char start))
(insert-before-markers
(funcall facemenu-add-face-function face end)))
(if facemenu-end-add-face
(insert (if (stringp facemenu-end-add-face)
facemenu-end-add-face
(funcall facemenu-end-add-face face)))))
(cond
((and (eq face 'default)
(not (eq facemenu-remove-face-function t)))
(if facemenu-remove-face-function
(funcall facemenu-remove-face-function start end)
(if (and start (< start end))
(let ((part-start start) part-end)
(while (not (= part-start end))
(setq part-end (next-single-property-change part-start 'face
nil end))
(let ((prev (get-text-property part-start 'face)))
(put-text-property part-start part-end 'face
(if (null prev)
face
(facemenu-active-faces
(cons face
(if (listp prev)
prev
(list prev)))
;; Specify the selected frame
;; because nil would mean to use
;; the new-frame default settings,
;; and those are usually nil.
(selected-frame)))))
(setq part-start part-end)))
(setq self-insert-face (if (eq last-command self-insert-face-command)
(cons face (if (listp self-insert-face)
self-insert-face
(list self-insert-face)))
face)
self-insert-face-command this-command))))
(remove-text-properties start end '(face default))
(facemenu-set-self-insert-face 'default))))
(facemenu-add-face-function
(save-excursion
(if end (goto-char end))
(save-excursion
(if start (goto-char start))
(insert-before-markers
(funcall facemenu-add-face-function face end)))
(if facemenu-end-add-face
(insert (if (stringp facemenu-end-add-face)
facemenu-end-add-face
(funcall facemenu-end-add-face face))))))
((and start (< start end))
(let ((part-start start) part-end)
(while (not (= part-start end))
(setq part-end (next-single-property-change part-start 'face
nil end))
(let ((prev (get-text-property part-start 'face)))
(put-text-property part-start part-end 'face
(if (null prev)
face
(facemenu-active-faces
(cons face
(if (listp prev)
prev
(list prev)))
;; Specify the selected frame
;; because nil would mean to use
;; the new-frame default settings,
;; and those are usually nil.
(selected-frame)))))
(setq part-start part-end))))
(t
(facemenu-set-self-insert-face
(if (eq last-command (cdr facemenu-self-insert-data))
(cons face (if (listp (car facemenu-self-insert-data))
(car facemenu-self-insert-data)
(list (car facemenu-self-insert-data))))
face))))
(unless (facemenu-enable-faces-p)
(message "Font-lock mode will override any faces you set in this buffer")))

46
lisp/files.el
View File

@ -757,21 +757,44 @@ one or more of those symbols."
(let ((x (file-name-directory suffix)))
(if x (1- (length x)) (length suffix))))))
(t
(let ((names nil)
(let ((names '())
;; If we have files like "foo.el" and "foo.elc", we could load one of
;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the
;; preferred way. So if we list all 3, that gives a lot of redundant
;; entries for the poor soul looking just for "foo". OTOH, sometimes
;; the user does want to pay attention to the extension. We try to
;; diffuse this tension by stripping the suffix, except when the
;; result is a single element (i.e. usually we only list "foo" unless
;; it's the only remaining element in the list, in which case we do
;; list "foo", "foo.elc" and "foo.el").
(fullnames '())
(suffix (concat (regexp-opt suffixes t) "\\'"))
(string-dir (file-name-directory string))
(string-file (file-name-nondirectory string)))
(dolist (dir dirs)
(unless dir
(setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir)))
(when (file-directory-p dir)
(dolist (file (file-name-all-completions
string-file dir))
(push file names)
(when (string-match suffix file)
(setq file (substring file 0 (match-beginning 0)))
(push file names)))))
(unless dir
(setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir)))
(when (file-directory-p dir)
(dolist (file (file-name-all-completions
string-file dir))
(if (not (string-match suffix file))
(push file names)
(push file fullnames)
(push (substring file 0 (match-beginning 0)) names)))))
;; Switching from names to names+fullnames creates a non-monotonicity
;; which can cause problems with things like partial-completion.
;; To minimize the problem, filter out completion-regexp-list, so that
;; M-x load-library RET t/x.e TAB finds some files.
(if completion-regexp-list
(setq names (all-completions "" names)))
;; Remove duplicates of the first element, so that we can easily check
;; if `names' really only contains a single element.
(when (cdr names) (setcdr names (delete (car names) (cdr names))))
(unless (cdr names)
;; There's no more than one matching non-suffixed element, so expand
;; the list by adding the suffixed elements as well.
(setq names (nconc names fullnames)))
(completion-table-with-context
string-dir names string-file pred action)))))
@ -2782,6 +2805,7 @@ asking you for confirmation."
(no-update-autoloads . booleanp)
(tab-width . integerp) ;; C source code
(truncate-lines . booleanp) ;; C source code
(word-wrap . booleanp) ;; C source code
(bidi-display-reordering . booleanp))) ;; C source code
(put 'bidi-paragraph-direction 'safe-local-variable

67
lisp/ido.el
View File

@ -780,7 +780,7 @@ Essentially it works as follows: Say you are visiting a file and
the buffer gets cleaned up by mignight.el. Later, you want to
switch to that buffer, but find it's no longer open. With
virtual buffers enabled, the buffer name stays in the buffer
list (using the ido-virtual face, and always at the end), and if
list (using the `ido-virtual' face, and always at the end), and if
you select it, it opens the file back up again. This allows you
to think less about whether recently opened files are still open
or not. Most of the time you can quit Emacs, restart, and then
@ -1070,11 +1070,11 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
;; Stores the current list of items that will be searched through.
;; The list is ordered, so that the most interesting item comes first,
;; although by default, the files visible in the current frame are put
;; at the end of the list.
(defvar ido-cur-list nil)
;; at the end of the list. Created by `ido-make-item-list'.
(defvar ido-cur-list)
;; Stores the choice list for ido-completing-read
(defvar ido-choice-list nil)
(defvar ido-choice-list)
;; Stores the list of items which are ignored when building
;; `ido-cur-list'. It is in no specific order.
@ -3400,11 +3400,9 @@ for first matching file."
(if ido-temp-list
(nconc ido-temp-list ido-current-buffers)
(setq ido-temp-list ido-current-buffers))
(when (and default (buffer-live-p (get-buffer default)))
(setq ido-temp-list
(cons default (delete default ido-temp-list))))
(if ido-use-virtual-buffers
(ido-add-virtual-buffers-to-list))
(if default
(setq ido-temp-list
(cons default (delete default ido-temp-list))))
(run-hooks 'ido-make-buffer-list-hook)
ido-temp-list))
@ -3672,7 +3670,6 @@ This is to make them appear as if they were \"virtual buffers\"."
;; Used by `ido-get-buffers-in-frames' to walk through all windows
(let ((buf (buffer-name (window-buffer win))))
(unless (or (member buf ido-bufs-in-frame)
(minibufferp buf)
(member buf ido-ignore-item-temp-list))
;; Only add buf if it is not already in list.
;; This prevents same buf in two different windows being
@ -3913,27 +3910,6 @@ This is to make them appear as if they were \"virtual buffers\"."
;;(add-hook 'completion-setup-hook 'completion-setup-function)
(display-completion-list completion-list)))))))
(defun ido-kill-buffer-internal (buf)
"Kill buffer BUF and rebuild ido's buffer list if needed."
(if (not (kill-buffer buf))
;; buffer couldn't be killed.
(setq ido-rescan t)
;; else buffer was killed so remove name from list.
(setq ido-cur-list (delq buf ido-cur-list))
;; Some packages, like uniquify.el, may rename buffers when one
;; is killed, so we need to test this condition to avoid using
;; an outdated list of buffer names. We don't want to always
;; rebuild the list of buffers, as this alters the previous
;; buffer order that the user was seeing on the prompt. However,
;; when we rebuild the list, we try to keep the previous second
;; buffer as the first one.
(catch 'update
(dolist (b ido-cur-list)
(unless (get-buffer b)
(setq ido-cur-list (ido-make-buffer-list (cadr ido-matches)))
(setq ido-rescan t)
(throw 'update nil))))))
;;; KILL CURRENT BUFFER
(defun ido-kill-buffer-at-head ()
"Kill the buffer at the head of `ido-matches'.
@ -3942,15 +3918,26 @@ If cursor is not at the end of the user input, delete to end of input."
(if (not (eobp))
(delete-region (point) (line-end-position))
(let ((enable-recursive-minibuffers t)
(buf (ido-name (car ido-matches))))
(when buf
(ido-kill-buffer-internal buf)
;; Check if buffer still exists.
(if (get-buffer buf)
;; buffer couldn't be killed.
(buf (ido-name (car ido-matches)))
(nextbuf (cadr ido-matches)))
(when (get-buffer buf)
;; If next match names a buffer use the buffer object; buffer
;; name may be changed by packages such as uniquify; mindful
;; of virtual buffers.
(when (and nextbuf (get-buffer nextbuf))
(setq nextbuf (get-buffer nextbuf)))
(if (null (kill-buffer buf))
;; Buffer couldn't be killed.
(setq ido-rescan t)
;; else buffer was killed so remove name from list.
(setq ido-cur-list (delq buf ido-cur-list)))))))
;; Else `kill-buffer' succeeds so re-make the buffer list
;; taking into account packages like uniquify may rename
;; buffers.
(if (bufferp nextbuf)
(setq nextbuf (buffer-name nextbuf)))
(setq ido-default-item nextbuf
ido-text-init ido-text
ido-exit 'refresh)
(exit-minibuffer))))))
;;; DELETE CURRENT FILE
(defun ido-delete-file-at-head ()
@ -3988,7 +3975,7 @@ Record command in `command-history' if optional RECORD is non-nil."
((eq method 'kill)
(if record
(ido-record-command 'kill-buffer buffer))
(ido-kill-buffer-internal buffer))
(kill-buffer buffer))
((eq method 'other-window)
(if record

83
lisp/image-mode.el
View File

@ -493,7 +493,10 @@ was inserted."
(buffer-substring-no-properties (point-min) (point-max)))
filename))
(type (image-type file-or-data nil data-p))
(image (create-animated-image file-or-data type data-p))
(image0 (create-animated-image file-or-data type data-p))
(image (append image0
(image-transform-properties image0)
))
(props
`(display ,image
intangible ,image
@ -556,6 +559,84 @@ the image file and `image-mode' showing the image as an image."
(when (not (string= image-type (bookmark-prop-get bmk 'image-type)))
(image-toggle-display))))
(defvar image-transform-minor-mode-map
(let ((map (make-sparse-keymap)))
; (define-key map [(control ?+)] 'image-scale-in)
; (define-key map [(control ?-)] 'image-scale-out)
; (define-key map [(control ?=)] 'image-scale-none)
;; (define-key map "c f h" 'image-scale-fit-height)
;; (define-key map "c ]" 'image-rotate-right)
map)
"Minor mode keymap for transforming the view of images Image mode.")
(define-minor-mode image-transform-mode
"minor mode for scaleing and rotation"
nil "image-transform"
image-transform-minor-mode-map)
(defvar image-transform-resize nil
"The image resize operation. See the command
`image-transform-set-scale' for more information." )
(defvar image-transform-rotation 0.0)
(defun image-transform-properties (display)
"Calculate the display properties for transformations; scaling
and rotation. "
(let*
((size (image-size display t))
(height
(cond
((and (numberp image-transform-resize) (eq 100 image-transform-resize))
nil)
((numberp image-transform-resize)
(* image-transform-resize (cdr size)))
((eq image-transform-resize 'fit-height)
(- (nth 3 (window-inside-pixel-edges)) (nth 1 (window-inside-pixel-edges))))
(t nil)))
(width (if (eq image-transform-resize 'fit-width)
(- (nth 2 (window-inside-pixel-edges)) (nth 0 (window-inside-pixel-edges))))))
`(,@(if height (list :height height))
,@(if width (list :width width))
,@(if (not (equal 0.0 image-transform-rotation))
(list :rotation image-transform-rotation))
;;TODO fit-to-* should consider the rotation angle
)))
(defun image-transform-set-scale (scale)
"SCALE sets the scaling for images. "
(interactive "nscale:")
(image-transform-set-resize (float scale)))
(defun image-transform-fit-to-height ()
"Fit image height to window height. "
(interactive)
(image-transform-set-resize 'fit-height))
(defun image-transform-fit-to-width ()
"Fit image width to window width. "
(interactive)
(image-transform-set-resize 'fit-width))
(defun image-transform-set-resize (resize)
"Set the resize mode for images. The RESIZE value can be the
symbol fit-height which fits the image to the window height. The
symbol fit-width fits the image to the window width. A number
indicates a scaling factor. nil indicates scale to 100%. "
(setq image-transform-resize resize)
(if (eq 'image-mode major-mode) (image-toggle-display-image)))
(defun image-transform-set-rotation (rotation)
"Set the image ROTATION angle. "
(interactive "nrotation:")
;;TODO 0 90 180 270 degrees are the only reasonable angles here
;;otherwise combining with rescaling will get very awkward
(setq image-transform-rotation (float rotation))
(if (eq major-mode 'image-mode) (image-toggle-display-image)))
(provide 'image-mode)
;; arch-tag: b5b2b7e6-26a7-4b79-96e3-1546b5c4c6cb

21
lisp/image.el
View File

@ -694,6 +694,27 @@ shall be displayed."
(cons images tmo))))))
(defcustom imagemagick-types-inhibit
'(C HTML HTM TXT PDF)
"Types the imagemagick loader should not try to handle.")
;;;###autoload
(defun imagemagick-register-types ()
"Register file types that imagemagick is able to handle."
(let ((im-types (imagemagick-types)))
(dolist (im-inhibit imagemagick-types-inhibit)
(setq im-types (remove im-inhibit im-types)))
(dolist (im-type im-types)
(let ((extension (downcase (symbol-name im-type))))
(push
(cons (concat "\\." extension "\\'") 'image-mode)
auto-mode-alist)
(push
(cons (concat "\\." extension "\\'") 'imagemagick)
image-type-file-name-regexps)))))
(provide 'image)
;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3

10
lisp/international/mule.el
View File

@ -326,8 +326,7 @@ Return t if file exists."
(with-current-buffer buffer
;; So that we don't get completely screwed if the
;; file is encoded in some complicated character set,
;; read it with real decoding, as a multibyte buffer,
;; even if this is a --unibyte Emacs session.
;; read it with real decoding, as a multibyte buffer.
(set-buffer-multibyte t)
;; Don't let deactivate-mark remain set.
(let (deactivate-mark)
@ -346,12 +345,7 @@ Return t if file exists."
(eval-buffer buffer nil
;; This is compatible with what `load' does.
(if purify-flag file fullname)
;; If this Emacs is running with --unibyte,
;; convert multibyte strings to unibyte
;; after reading them.
;; (not (default-value 'enable-multibyte-characters))
nil t
))
nil t))
(let (kill-buffer-hook kill-buffer-query-functions)
(kill-buffer buffer)))
(do-after-load-evaluation fullname)

10
lisp/iswitchb.el
View File

@ -1027,8 +1027,8 @@ Return the modified list with the last element prepended to it."
(defun iswitchb-kill-buffer ()
"Kill the buffer at the head of `iswitchb-matches'."
(interactive)
(let ( (enable-recursive-minibuffers t)
buf)
(let ((enable-recursive-minibuffers t)
buf)
(setq buf (car iswitchb-matches))
;; check to see if buf is non-nil.
@ -1042,8 +1042,10 @@ Return the modified list with the last element prepended to it."
(if (get-buffer buf)
;; buffer couldn't be killed.
(setq iswitchb-rescan t)
;; else buffer was killed so remove name from list.
(setq iswitchb-buflist (delq buf iswitchb-buflist)))))))
;; Else `kill-buffer' succeeds so re-make the buffer list
;; taking into account packages like uniquify may rename
;; buffers
(iswitchb-make-buflist iswitchb-default))))))
;;; VISIT CHOSEN BUFFER
(defun iswitchb-visit-buffer (buffer)

13
lisp/mail/rmail.el
View File

@ -191,8 +191,6 @@ please report it with \\[report-emacs-bug].")
:group 'rmail-retrieve
:type '(repeat (directory)))
(declare-function mail-position-on-field "sendmail" (field &optional soft))
(declare-function mail-text-start "sendmail" ())
(declare-function rmail-dont-reply-to "mail-utils" (destinations))
(declare-function rmail-update-summary "rmailsum" (&rest ignore))
@ -1643,8 +1641,6 @@ The duplicate copy goes into the Rmail file just after the original."
(declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel))
(declare-function rfc822-addresses "rfc822" (header-text))
(declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ())
(declare-function mail-sendmail-delimit-header "sendmail" ())
(declare-function mail-header-end "sendmail" ())
;; RLK feature not added in this version:
;; argument specifies inbox file or files in various ways.
@ -3686,7 +3682,8 @@ see the documentation of `rmail-resend'."
;; The mail buffer is now current.
(save-excursion
;; Insert after header separator--before signature if any.
(goto-char (mail-text-start))
(rfc822-goto-eoh)
(forward-line 1)
(if (or rmail-enable-mime rmail-enable-mime-composing)
(funcall rmail-insert-mime-forwarded-message-function
forward-buffer)
@ -3841,6 +3838,10 @@ The message should be narrowed to just the headers."
(1- (point))
(point-max)))))))
(declare-function mail-sendmail-delimit-header "sendmail" ())
(declare-function mail-header-end "sendmail" ())
(declare-function mail-position-on-field "sendmail" (field &optional soft))
(defun rmail-retry-failure ()
"Edit a mail message which is based on the contents of the current message.
For a message rejected by the mail system, extract the interesting headers and
@ -3932,6 +3933,8 @@ specifying headers which should not be copied into the new message."
(goto-char (point-min))
(if bounce-indent
(indent-rigidly (point-min) (point-max) bounce-indent))
;; FIXME better to replace sendmail functions.
(require 'sendmail)
(mail-sendmail-delimit-header)
(save-restriction
(narrow-to-region (point-min) (mail-header-end))

5
lisp/makefile.w32-in
View File

@ -32,10 +32,9 @@ srcdir = $(CURDIR)/..
EMACS = $(THISDIR)/../bin/emacs.exe
# Command line flags for Emacs. This must include --multibyte,
# otherwise some files will not compile.
# Command line flags for Emacs.
EMACSOPT = -batch --no-init-file --no-site-file --multibyte
EMACSOPT = -batch --no-init-file --no-site-file
# Extra flags to pass to the byte compiler
BYTE_COMPILE_EXTRA_FLAGS =

3
lisp/menu-bar.el
View File

@ -1272,6 +1272,9 @@ mail status in mode line"))
(define-key menu-bar-games-menu [life]
`(menu-item ,(purecopy "Life") life
:help ,(purecopy "Watch how John Conway's cellular automaton evolves")))
(define-key menu-bar-games-menu [land]
`(menu-item ,(purecopy "Landmark") landmark
:help ,(purecopy "Watch a neural-network robot learn landmarks")))
(define-key menu-bar-games-menu [hanoi]
`(menu-item ,(purecopy "Towers of Hanoi") hanoi
:help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs")))

706
lisp/mouse.el
View File

@ -1268,10 +1268,11 @@ regardless of where you click."
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
;; Without this, confusing things happen upon e.g. inserting into
;; the middle of an active region.
(when select-active-regions
;; Without this, confusing things happen upon e.g. inserting into
;; the middle of an active region.
(deactivate-mark))
(let (select-active-regions)
(deactivate-mark)))
(or mouse-yank-at-point (mouse-set-point click))
(let ((primary
(cond
@ -1297,8 +1298,7 @@ This does not delete the region; it acts like \\[kill-ring-save]."
;; whenever it was equal to the front of the kill ring, but some
;; people found that confusing.
;; A list (TEXT START END), describing the text and position of the last
;; invocation of mouse-save-then-kill.
;; The position of the last invocation of `mouse-save-then-kill'.
(defvar mouse-save-then-kill-posn nil)
(defun mouse-save-then-kill-delete-region (beg end)
@ -1336,111 +1336,76 @@ This does not delete the region; it acts like \\[kill-ring-save]."
(undo-boundary))
(defun mouse-save-then-kill (click)
"Set the region according to CLICK; the second time, kill the region.
Assuming this command is bound to a mouse button, CLICK is the
corresponding input event.
"Set the region according to CLICK; the second time, kill it.
CLICK should be a mouse click event.
If the region is already active, adjust it. Normally, this
happens by moving either point or mark, whichever is closer, to
the position of CLICK. But if you have selected words or lines,
the region is adjusted by moving point or mark to the word or
line boundary closest to CLICK.
If the region is inactive, activate it temporarily. Set mark at
the original point, and move point to the position of CLICK.
If the region is inactive, activate it temporarily; set mark at
the original point, and move click to the position of CLICK.
If the region is already active, adjust it. Normally, do this by
moving point or mark, whichever is closer, to CLICK. But if you
have selected whole words or lines, move point or mark to the
word or line boundary closest to CLICK instead.
However, if this command is being called a second time (i.e. the
value of `last-command' is `mouse-save-then-kill'), kill the
region instead. If the text in the region is the same as the
text in the front of the kill ring, just delete it."
If this command is called a second consecutive time with the same
CLICK position, kill the region."
(interactive "e")
(let ((before-scroll
(with-current-buffer (window-buffer (posn-window (event-start click)))
point-before-scroll)))
(mouse-minibuffer-check click)
(let ((click-posn (posn-point (event-start click)))
;; Don't let a subsequent kill command append to this one:
;; prevent setting this-command to kill-region.
(this-command this-command))
(if (and (with-current-buffer
(window-buffer (posn-window (event-start click)))
(and (mark t)
(> (mod mouse-selection-click-count 3) 0)
;; Don't be fooled by a recent click in some other buffer.
(eq mouse-selection-click-count-buffer
(current-buffer)))))
(if (and (eq last-command 'mouse-save-then-kill)
(equal click-posn (nth 2 mouse-save-then-kill-posn)))
;; If we click this button again without moving it, kill.
(progn
;; Call `deactivate-mark' to save the primary selection.
(deactivate-mark)
(mouse-save-then-kill-delete-region (mark) (point))
(setq mouse-selection-click-count 0)
(setq mouse-save-then-kill-posn nil))
;; Find both ends of the object selected by this click.
(let* ((range
(mouse-start-end click-posn click-posn
mouse-selection-click-count)))
;; Move whichever end is closer to the click.
;; That's what xterm does, and it seems reasonable.
(if (< (abs (- click-posn (mark t)))
(abs (- click-posn (point))))
(set-mark (car range))
(goto-char (nth 1 range)))
;; We have already put the old region in the kill ring.
;; Replace it with the extended region.
;; (It would be annoying to make a separate entry.)
(kill-new (buffer-substring (point) (mark t)) t)
(mouse-set-region-1)
;; Arrange for a repeated mouse-3 to kill this region.
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn))))
(mouse-minibuffer-check click)
(let* ((posn (event-start click))
(click-pt (posn-point posn))
(window (posn-window posn))
(buf (window-buffer window))
;; Don't let a subsequent kill command append to this one.
(this-command this-command)
;; Check if the user has multi-clicked to select words/lines.
(click-count
(if (and (eq mouse-selection-click-count-buffer buf)
(with-current-buffer buf (mark t)))
mouse-selection-click-count
0)))
(cond
((not (numberp click-pt)) nil)
;; If the user clicked without moving point, kill the region.
;; This also resets `mouse-selection-click-count'.
((and (eq last-command 'mouse-save-then-kill)
(eq click-pt mouse-save-then-kill-posn)
(eq window (selected-window)))
(kill-region (mark t) (point))
(setq mouse-selection-click-count 0)
(setq mouse-save-then-kill-posn nil))
;; Otherwise, if there is a suitable region, adjust it by moving
;; one end (whichever is closer) to CLICK-PT.
((or (with-current-buffer buf (region-active-p))
(and (eq window (selected-window))
(mark t)
(or (and (eq last-command 'mouse-save-then-kill)
mouse-save-then-kill-posn)
(and (memq last-command '(mouse-drag-region
mouse-set-region))
(or mark-even-if-inactive
(not transient-mark-mode))))))
(select-window window)
(let* ((range (mouse-start-end click-pt click-pt click-count)))
(if (< (abs (- click-pt (mark t)))
(abs (- click-pt (point))))
(set-mark (car range))
(goto-char (nth 1 range)))
(setq deactivate-mark nil)
(mouse-set-region-1)
;; Arrange for a repeated mouse-3 to kill the region.
(setq mouse-save-then-kill-posn click-pt)))
;; Otherwise, set the mark where point is and move to CLICK-PT.
(t
(select-window window)
(mouse-set-mark-fast click)
(let ((before-scroll (with-current-buffer buf point-before-scroll)))
(if before-scroll (goto-char before-scroll)))
(exchange-point-and-mark)
(mouse-set-region-1)
(setq mouse-save-then-kill-posn click-pt)))))
(if (and (eq last-command 'mouse-save-then-kill)
mouse-save-then-kill-posn
(eq (car mouse-save-then-kill-posn) (car kill-ring))
(equal (cdr mouse-save-then-kill-posn)
(list (point) click-posn)))
;; If this is the second time we've called
;; mouse-save-then-kill, delete the text from the buffer.
(progn
;; Call `deactivate-mark' to save the primary selection.
(deactivate-mark)
(mouse-save-then-kill-delete-region (point) (mark t))
;; After we kill, another click counts as "the first time".
(setq mouse-save-then-kill-posn nil))
;; This is not a repetition.
;; We are adjusting an old selection or creating a new one.
(if (or (and (eq last-command 'mouse-save-then-kill)
mouse-save-then-kill-posn)
(and mark-active transient-mark-mode)
(and (memq last-command
'(mouse-drag-region mouse-set-region))
(or mark-even-if-inactive
(not transient-mark-mode))))
;; We have a selection or suitable region, so adjust it.
(let* ((posn (event-start click))
(new (posn-point posn)))
(select-window (posn-window posn))
(if (numberp new)
(progn
;; Move whichever end of the region is closer to the click.
;; That is what xterm does, and it seems reasonable.
(if (<= (abs (- new (point))) (abs (- new (mark t))))
(goto-char new)
(set-mark new))
(setq deactivate-mark nil)))
(kill-new (buffer-substring (point) (mark t)) t))
;; Set the mark where point is, then move where clicked.
(mouse-set-mark-fast click)
(if before-scroll
(goto-char before-scroll))
(exchange-point-and-mark) ;Why??? --Stef
(kill-new (buffer-substring (point) (mark t))))
(mouse-set-region-1)
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))))))
(global-set-key [M-mouse-1] 'mouse-start-secondary)
(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
@ -1520,9 +1485,6 @@ The function returns a non-nil value if it creates a secondary selection."
;; of one word or line.
(let ((range (mouse-start-end start-point start-point click-count)))
(set-marker mouse-secondary-start nil)
;; Why the double move? --Stef
;; (move-overlay mouse-secondary-overlay 1 1
;; (window-buffer start-window))
(move-overlay mouse-secondary-overlay (car range) (nth 1 range)
(window-buffer start-window)))
;; Single-press: cancel any preexisting secondary selection.
@ -1616,117 +1578,99 @@ is to prevent accidents."
(delete-overlay mouse-secondary-overlay))
(defun mouse-secondary-save-then-kill (click)
"Save text to point in kill ring; the second time, kill the text.
You must use this in a buffer where you have recently done \\[mouse-start-secondary].
If the text between where you did \\[mouse-start-secondary] and where
you use this command matches the text at the front of the kill ring,
this command deletes the text.
Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
which prepares for a second click with this command to delete the text.
"Set the secondary selection and save it to the kill ring.
The second time, kill it. CLICK should be a mouse click event.
If you have already made a secondary selection in that buffer,
this command extends or retracts the selection to where you click.
If you do this again in a different position, it extends or retracts
again. If you do this twice in the same position, it kills the selection."
If you have not called `mouse-start-secondary' in the clicked
buffer, activate the secondary selection and set it between point
and the click position CLICK.
Otherwise, adjust the bounds of the secondary selection.
Normally, do this by moving its beginning or end, whichever is
closer, to CLICK. But if you have selected whole words or lines,
adjust to the word or line boundary closest to CLICK instead.
If this command is called a second consecutive time with the same
CLICK position, kill the secondary selection."
(interactive "e")
(mouse-minibuffer-check click)
(let ((posn (event-start click))
(click-posn (posn-point (event-start click)))
;; Don't let a subsequent kill command append to this one:
;; prevent setting this-command to kill-region.
(this-command this-command))
(or (eq (window-buffer (posn-window posn))
(or (overlay-buffer mouse-secondary-overlay)
(if mouse-secondary-start
(marker-buffer mouse-secondary-start))))
(error "Wrong buffer"))
(with-current-buffer (window-buffer (posn-window posn))
(if (> (mod mouse-secondary-click-count 3) 0)
(if (not (and (eq last-command 'mouse-secondary-save-then-kill)
(equal click-posn
(car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
;; Find both ends of the object selected by this click.
(let* ((range
(mouse-start-end click-posn click-posn
mouse-secondary-click-count)))
;; Move whichever end is closer to the click.
;; That's what xterm does, and it seems reasonable.
(if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
(abs (- click-posn (overlay-end mouse-secondary-overlay))))
(move-overlay mouse-secondary-overlay (car range)
(overlay-end mouse-secondary-overlay))
(move-overlay mouse-secondary-overlay
(overlay-start mouse-secondary-overlay)
(nth 1 range)))
;; We have already put the old region in the kill ring.
;; Replace it with the extended region.
;; (It would be annoying to make a separate entry.)
(kill-new (buffer-substring
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)) t)
;; Arrange for a repeated mouse-3 to kill this region.
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))
;; If we click this button again without moving it,
;; that time kill.
(progn
(mouse-save-then-kill-delete-region
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))
(setq mouse-save-then-kill-posn nil)
(setq mouse-secondary-click-count 0)
(delete-overlay mouse-secondary-overlay)))
(if (and (eq last-command 'mouse-secondary-save-then-kill)
mouse-save-then-kill-posn
(eq (car mouse-save-then-kill-posn) (car kill-ring))
(equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
;; If this is the second time we've called
;; mouse-secondary-save-then-kill, delete the text from the buffer.
(progn
(mouse-save-then-kill-delete-region
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))
(setq mouse-save-then-kill-posn nil)
(delete-overlay mouse-secondary-overlay))
(if (overlay-start mouse-secondary-overlay)
;; We have a selection, so adjust it.
(progn
(if (numberp click-posn)
(progn
;; Move whichever end of the region is closer to the click.
;; That is what xterm does, and it seems reasonable.
(if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
(abs (- click-posn (overlay-end mouse-secondary-overlay))))
(move-overlay mouse-secondary-overlay click-posn
(overlay-end mouse-secondary-overlay))
(move-overlay mouse-secondary-overlay
(overlay-start mouse-secondary-overlay)
click-posn))
(setq deactivate-mark nil)))
(if (eq last-command 'mouse-secondary-save-then-kill)
;; If the front of the kill ring comes from
;; an immediately previous use of this command,
;; replace it with the extended region.
;; (It would be annoying to make a separate entry.)
(kill-new (buffer-substring
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)) t)
(let (deactivate-mark)
(copy-region-as-kill (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))))
(if mouse-secondary-start
;; All we have is one end of a selection,
;; so put the other end here.
(let ((start (+ 0 mouse-secondary-start)))
(kill-ring-save start click-posn)
(move-overlay mouse-secondary-overlay start click-posn))))
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn))))
(if (overlay-buffer mouse-secondary-overlay)
(x-set-selection 'SECONDARY
(buffer-substring
(overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))))))
(let* ((posn (event-start click))
(click-pt (posn-point posn))
(window (posn-window posn))
(buf (window-buffer window))
;; Don't let a subsequent kill command append to this one.
(this-command this-command)
;; Check if the user has multi-clicked to select words/lines.
(click-count
(if (eq (overlay-buffer mouse-secondary-overlay) buf)
mouse-secondary-click-count
0))
(beg (overlay-start mouse-secondary-overlay))
(end (overlay-end mouse-secondary-overlay)))
(cond
((not (numberp click-pt)) nil)
;; If the secondary selection is not active in BUF, activate it.
((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
(if mouse-secondary-start
(marker-buffer mouse-secondary-start)))))
(select-window window)
(setq mouse-secondary-start (make-marker))
(move-marker mouse-secondary-start (point))
(move-overlay mouse-secondary-overlay (point) click-pt buf)
(kill-ring-save (point) click-pt))
;; If the user clicked without moving point, delete the secondary
;; selection. This also resets `mouse-secondary-click-count'.
((and (eq last-command 'mouse-secondary-save-then-kill)
(eq click-pt mouse-save-then-kill-posn)
(eq window (selected-window)))
(mouse-save-then-kill-delete-region beg end)
(delete-overlay mouse-secondary-overlay)
(setq mouse-secondary-click-count 0)
(setq mouse-save-then-kill-posn nil))
;; Otherwise, if there is a suitable secondary selection overlay,
;; adjust it by moving one end (whichever is closer) to CLICK-PT.
((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
(let* ((range (mouse-start-end click-pt click-pt click-count)))
(if (< (abs (- click-pt beg))
(abs (- click-pt end)))
(move-overlay mouse-secondary-overlay (car range) end)
(move-overlay mouse-secondary-overlay beg (nth 1 range))))
(setq deactivate-mark nil)
(if (eq last-command 'mouse-secondary-save-then-kill)
;; If the front of the kill ring comes from an immediately
;; previous use of this command, replace the entry.
(kill-new
(buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))
t)
(let (deactivate-mark)
(copy-region-as-kill (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))))
(setq mouse-save-then-kill-posn click-pt))
;; Otherwise, set the secondary selection overlay.
(t
(select-window window)
(if mouse-secondary-start
;; All we have is one end of a selection, so put the other
;; end here.
(let ((start (+ 0 mouse-secondary-start)))
(kill-ring-save start click-pt)
(move-overlay mouse-secondary-overlay start click-pt)))
(setq mouse-save-then-kill-posn click-pt))))
;; Finally, set the window system's secondary selection.
(let (str)
(and (overlay-buffer mouse-secondary-overlay)
(setq str (buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))
(> (length str) 0)
(x-set-selection 'SECONDARY str))))
(defcustom mouse-buffer-menu-maxlen 20
"Number of buffers in one pane (submenu) of the buffer menu.
@ -1907,332 +1851,6 @@ and selects that window."
;; Few buffers--put them all in one pane.
(list (cons title alist))))
;; These need to be rewritten for the new scroll bar implementation.
;;!! ;; Commands for the scroll bar.
;;!!
;;!! (defun mouse-scroll-down (click)
;;!! (interactive "@e")
;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
;;!!
;;!! (defun mouse-scroll-up (click)
;;!! (interactive "@e")
;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
;;!!
;;!! (defun mouse-scroll-down-full ()
;;!! (interactive "@")
;;!! (scroll-down nil))
;;!!
;;!! (defun mouse-scroll-up-full ()
;;!! (interactive "@")
;;!! (scroll-up nil))
;;!!
;;!! (defun mouse-scroll-move-cursor (click)
;;!! (interactive "@e")
;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
;;!!
;;!! (defun mouse-scroll-absolute (event)
;;!! (interactive "@e")
;;!! (let* ((pos (car event))
;;!! (position (car pos))
;;!! (length (car (cdr pos))))
;;!! (if (<= length 0) (setq length 1))
;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
;;!! position)
;;!! length)
;;!! scale-factor)))
;;!! (goto-char newpos)
;;!! (recenter '(4)))))
;;!!
;;!! (defun mouse-scroll-left (click)
;;!! (interactive "@e")
;;!! (scroll-left (1+ (car (mouse-coords click)))))
;;!!
;;!! (defun mouse-scroll-right (click)
;;!! (interactive "@e")
;;!! (scroll-right (1+ (car (mouse-coords click)))))
;;!!
;;!! (defun mouse-scroll-left-full ()
;;!! (interactive "@")
;;!! (scroll-left nil))
;;!!
;;!! (defun mouse-scroll-right-full ()
;;!! (interactive "@")
;;!! (scroll-right nil))
;;!!
;;!! (defun mouse-scroll-move-cursor-horizontally (click)
;;!! (interactive "@e")
;;!! (move-to-column (1+ (car (mouse-coords click)))))
;;!!
;;!! (defun mouse-scroll-absolute-horizontally (event)
;;!! (interactive "@e")
;;!! (let* ((pos (car event))
;;!! (position (car pos))
;;!! (length (car (cdr pos))))
;;!! (set-window-hscroll (selected-window) 33)))
;;!!
;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
;;!!
;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
;;!!
;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
;;!!
;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
;;!!
;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
;;!! (global-set-key [horizontal-scroll-bar mouse-2]
;;!! 'mouse-scroll-absolute-horizontally)
;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
;;!!
;;!! (global-set-key [horizontal-slider mouse-1]
;;!! 'mouse-scroll-move-cursor-horizontally)
;;!! (global-set-key [horizontal-slider mouse-2]
;;!! 'mouse-scroll-move-cursor-horizontally)
;;!! (global-set-key [horizontal-slider mouse-3]
;;!! 'mouse-scroll-move-cursor-horizontally)
;;!!
;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
;;!!
;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
;;!!
;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
;;!! 'mouse-split-window-horizontally)
;;!! (global-set-key [mode-line S-mouse-2]
;;!! 'mouse-split-window-horizontally)
;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
;;!! 'mouse-split-window)
;;!! ;;;;
;;!! ;;;; Here are experimental things being tested. Mouse events
;;!! ;;;; are of the form:
;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
;;!! ;;
;;!! ;;;;
;;!! ;;;; Dynamically track mouse coordinates
;;!! ;;;;
;;!! ;;
;;!! ;;(defun track-mouse (event)
;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
;;!! ;; (interactive "@e")
;;!! ;; (while mouse-grabbed
;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
;;!! ;; (abs-x (car pos))
;;!! ;; (abs-y (cdr pos))
;;!! ;; (relative-coordinate (coordinates-in-window-p
;;!! ;; (list (car pos) (cdr pos))
;;!! ;; (selected-window))))
;;!! ;; (if (consp relative-coordinate)
;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
;;!! ;; (car relative-coordinate)
;;!! ;; (car (cdr relative-coordinate)))
;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
;;!!
;;!! ;;
;;!! ;; Dynamically put a box around the line indicated by point
;;!! ;;
;;!! ;;
;;!! ;;(require 'backquote)
;;!! ;;
;;!! ;;(defun mouse-select-buffer-line (event)
;;!! ;; (interactive "@e")
;;!! ;; (let ((relative-coordinate
;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
;;!! ;; (abs-y (car (cdr (car event)))))
;;!! ;; (if (consp relative-coordinate)
;;!! ;; (progn
;;!! ;; (save-excursion
;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
;;!! ;; (x-draw-rectangle
;;!! ;; (selected-screen)
;;!! ;; abs-y 0
;;!! ;; (save-excursion
;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
;;!! ;; (end-of-line)
;;!! ;; (push-mark nil t)
;;!! ;; (beginning-of-line)
;;!! ;; (- (region-end) (region-beginning))) 1))
;;!! ;; (sit-for 1)
;;!! ;; (x-erase-rectangle (selected-screen))))))
;;!! ;;
;;!! ;;(defvar last-line-drawn nil)
;;!! ;;(defvar begin-delim "[^ \t]")
;;!! ;;(defvar end-delim "[^ \t]")
;;!! ;;
;;!! ;;(defun mouse-boxing (event)
;;!! ;; (interactive "@e")
;;!! ;; (save-excursion
;;!! ;; (let ((screen (selected-screen)))
;;!! ;; (while (= (x-mouse-events) 0)
;;!! ;; (let* ((pos (read-mouse-position screen))
;;!! ;; (abs-x (car pos))
;;!! ;; (abs-y (cdr pos))
;;!! ;; (relative-coordinate
;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y)
;;!! ;; (selected-window)))
;;!! ;; (begin-reg nil)
;;!! ;; (end-reg nil)
;;!! ;; (end-column nil)
;;!! ;; (begin-column nil))
;;!! ;; (if (and (consp relative-coordinate)
;;!! ;; (or (not last-line-drawn)
;;!! ;; (not (= last-line-drawn abs-y))))
;;!! ;; (progn
;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
;;!! ;; (if (= (following-char) 10)
;;!! ;; ()
;;!! ;; (progn
;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
;;!! ;; (setq begin-column (1- (current-column)))
;;!! ;; (end-of-line)
;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
;;!! ;; (setq end-column (1+ (current-column)))
;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
;;!! ;; (x-draw-rectangle screen
;;!! ;; (setq last-line-drawn abs-y)
;;!! ;; begin-column
;;!! ;; (- end-column begin-column) 1))))))))))
;;!! ;;
;;!! ;;(defun mouse-erase-box ()
;;!! ;; (interactive)
;;!! ;; (if last-line-drawn
;;!! ;; (progn
;;!! ;; (x-erase-rectangle (selected-screen))
;;!! ;; (setq last-line-drawn nil))))
;;!!
;;!! ;;; (defun test-x-rectangle ()
;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
;;!!
;;!! ;;
;;!! ;; Here is how to do double clicking in lisp. About to change.
;;!! ;;
;;!!
;;!! (defvar double-start nil)
;;!! (defconst double-click-interval 300
;;!! "Max ticks between clicks")
;;!!
;;!! (defun double-down (event)
;;!! (interactive "@e")
;;!! (if double-start
;;!! (let ((interval (- (nth 4 event) double-start)))
;;!! (if (< interval double-click-interval)
;;!! (progn
;;!! (backward-up-list 1)
;;!! ;; (message "Interval %d" interval)
;;!! (sleep-for 1)))
;;!! (setq double-start nil))
;;!! (setq double-start (nth 4 event))))
;;!!
;;!! (defun double-up (event)
;;!! (interactive "@e")
;;!! (and double-start
;;!! (> (- (nth 4 event ) double-start) double-click-interval)
;;!! (setq double-start nil)))
;;!!
;;!! ;;; (defun x-test-doubleclick ()
;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
;;!!
;;!! ;;
;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
;;!! ;;
;;!!
;;!! (defvar scrolled-lines 0)
;;!! (defconst scroll-speed 1)
;;!!
;;!! (defun incr-scroll-down (event)
;;!! (interactive "@e")
;;!! (setq scrolled-lines 0)
;;!! (incremental-scroll scroll-speed))
;;!!
;;!! (defun incr-scroll-up (event)
;;!! (interactive "@e")
;;!! (setq scrolled-lines 0)
;;!! (incremental-scroll (- scroll-speed)))
;;!!
;;!! (defun incremental-scroll (n)
;;!! (while (= (x-mouse-events) 0)
;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
;;!! (scroll-down n)
;;!! (sit-for 300 t)))
;;!!
;;!! (defun incr-scroll-stop (event)
;;!! (interactive "@e")
;;!! (message "Scrolled %d lines" scrolled-lines)
;;!! (setq scrolled-lines 0)
;;!! (sleep-for 1))
;;!!
;;!! ;;; (defun x-testing-scroll ()
;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
;;!!
;;!! ;;
;;!! ;; Some playthings suitable for picture mode? They need work.
;;!! ;;
;;!!
;;!! (defun mouse-kill-rectangle (event)
;;!! "Kill the rectangle between point and the mouse cursor."
;;!! (interactive "@e")
;;!! (let ((point-save (point)))
;;!! (save-excursion
;;!! (mouse-set-point event)
;;!! (push-mark nil t)
;;!! (if (> point-save (point))
;;!! (kill-rectangle (point) point-save)
;;!! (kill-rectangle point-save (point))))))
;;!!
;;!! (defun mouse-open-rectangle (event)
;;!! "Kill the rectangle between point and the mouse cursor."
;;!! (interactive "@e")
;;!! (let ((point-save (point)))
;;!! (save-excursion
;;!! (mouse-set-point event)
;;!! (push-mark nil t)
;;!! (if (> point-save (point))
;;!! (open-rectangle (point) point-save)
;;!! (open-rectangle point-save (point))))))
;;!!
;;!! ;; Must be a better way to do this.
;;!!
;;!! (defun mouse-multiple-insert (n char)
;;!! (while (> n 0)
;;!! (insert char)
;;!! (setq n (1- n))))
;;!!
;;!! ;; What this could do is not finalize until button was released.
;;!!
;;!! (defun mouse-move-text (event)
;;!! "Move text from point to cursor position, inserting spaces."
;;!! (interactive "@e")
;;!! (let* ((relative-coordinate
;;!! (coordinates-in-window-p (car event) (selected-window))))
;;!! (if (consp relative-coordinate)
;;!! (cond ((> (current-column) (car relative-coordinate))
;;!! (delete-char
;;!! (- (car relative-coordinate) (current-column))))
;;!! ((< (current-column) (car relative-coordinate))
;;!! (mouse-multiple-insert
;;!! (- (car relative-coordinate) (current-column)) " "))
;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
(define-obsolete-function-alias
'mouse-choose-completion 'choose-completion "23.2")
@ -2475,10 +2093,6 @@ choose a font."
(mouse-menu-bar-map)
(mouse-menu-major-mode-map)))))
;; Replaced with dragging mouse-1
;; (global-set-key [S-mouse-1] 'mouse-set-mark)
;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
;; vertical-line prevents Emacs from signaling an error when the mouse
;; button is released after dragging these lines, on non-toolkit

55
lisp/net/dbus.el
View File

@ -108,15 +108,12 @@ catched in `condition-case' by `dbus-error'.")
;;; Hash table of registered functions.
;; We create it here. So we have a simple test in dbusbind.c, whether
;; the Lisp code has been loaded.
(setq dbus-registered-objects-table (make-hash-table :test 'equal))
(defvar dbus-return-values-table (make-hash-table :test 'equal)
"Hash table for temporary storing arguments of reply messages.
A key in this hash table is a list (BUS SERIAL). BUS is either the
symbol `:system' or the symbol `:session'. SERIAL is the serial number
of the reply message. See `dbus-call-method-non-blocking-handler' and
A key in this hash table is a list (BUS SERIAL). BUS is either a
Lisp symbol, `:system' or `:session', or a string denoting the
bus address. SERIAL is the serial number of the reply message.
See `dbus-call-method-non-blocking-handler' and
`dbus-call-method-non-blocking'.")
(defun dbus-list-hash-table ()
@ -187,8 +184,8 @@ association to the service from D-Bus."
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
BUS must be either the symbol `:system' or the symbol `:session'.
SERVICE must be a known service name."
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address. SERVICE must be a known service name."
(maphash
(lambda (key value)
(dolist (elt value)
@ -353,15 +350,15 @@ EVENT is a list which starts with symbol `dbus-event':
(dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
either the symbol `:system' or the symbol `:session'. TYPE is
the D-Bus message type which has caused the event, SERIAL is the
serial number of the received D-Bus message. SERVICE and PATH
are the unique name and the object path of the D-Bus object
emitting the message. INTERFACE and MEMBER denote the message
which has been sent. HANDLER is the function which has been
registered for this message. ARGS are the arguments passed to
HANDLER, when it is called during event handling in
`dbus-handle-event'.
either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address. TYPE is the D-Bus message type which
has caused the event, SERIAL is the serial number of the received
D-Bus message. SERVICE and PATH are the unique name and the
object path of the D-Bus object emitting the message. INTERFACE
and MEMBER denote the message which has been sent. HANDLER is
the function which has been registered for this message. ARGS
are the arguments passed to HANDLER, when it is called during
event handling in `dbus-handle-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
@ -369,7 +366,8 @@ not well formed."
(unless (and (listp event)
(eq (car event) 'dbus-event)
;; Bus symbol.
(symbolp (nth 1 event))
(or (symbolp (nth 1 event))
(stringp (nth 1 event)))
;; Type.
(and (natnump (nth 2 event))
(< dbus-message-type-invalid (nth 2 event)))
@ -434,9 +432,10 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(defun dbus-event-bus-name (event)
"Return the bus name the event is coming from.
The result is either the symbol `:system' or the symbol `:session'.
EVENT is a D-Bus event, see `dbus-check-event'. This function
raises a `dbus-error' signal in case the event is not well formed."
The result is either a Lisp symbol, `:system' or `:session', or a
string denoting the bus address. EVENT is a D-Bus event, see
`dbus-check-event'. This function raises a `dbus-error' signal
in case the event is not well formed."
(dbus-check-event event)
(nth 1 event))
@ -566,10 +565,11 @@ apply
"Return all interfaces and sub-nodes of SERVICE,
registered at object path PATH at bus BUS.
BUS must be either the symbol `:system' or the symbol `:session'.
SERVICE must be a known service name, and PATH must be a valid
object path. The last two parameters are strings. The result,
the introspection data, is a string in XML format."
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address. SERVICE must be a known service name,
and PATH must be a valid object path. The last two parameters
are strings. The result, the introspection data, is a string in
XML format."
;; We don't want to raise errors. `dbus-call-method-non-blocking'
;; is used, because the handler can be registered in our Emacs
;; instance; caller an callee would block each other.
@ -873,7 +873,8 @@ name of the property, and its value. If there are no properties,
(bus service path interface property access value &optional emits-signal)
"Register property PROPERTY on the D-Bus BUS.
BUS is either the symbol `:system' or the symbol `:session'.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus. It must be a
known name.

3
lisp/progmodes/flymake.el
View File

@ -1152,7 +1152,8 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(when dir
(let ((default-directory dir))
(flymake-log 3 "starting process on dir %s" default-directory)))
(setq process (apply 'start-process "flymake-proc" (current-buffer) cmd args))
(setq process (apply 'start-file-process
"flymake-proc" (current-buffer) cmd args))
(set-process-sentinel process 'flymake-process-sentinel)
(set-process-filter process 'flymake-process-filter)
(push process flymake-processes)

8
lisp/progmodes/make-mode.el
View File

@ -1300,7 +1300,9 @@ definition and conveniently use this command."
(save-restriction
(narrow-to-region beginning end)
(makefile-backslash-region (point-min) (point-max) t)
(let ((fill-paragraph-function nil))
(let ((fill-paragraph-function nil)
;; Adjust fill-column to allow space for the backslash.
(fill-column (- fill-column 1)))
(fill-paragraph nil))
(makefile-backslash-region (point-min) (point-max) nil)
(goto-char (point-max))
@ -1314,7 +1316,9 @@ definition and conveniently use this command."
;; resulting region.
(save-restriction
(narrow-to-region (point) (line-beginning-position 2))
(let ((fill-paragraph-function nil))
(let ((fill-paragraph-function nil)
;; Adjust fill-column to allow space for the backslash.
(fill-column (- fill-column 1)))
(fill-paragraph nil))
(makefile-backslash-region (point-min) (point-max) nil))
;; Return non-nil to indicate it's been filled.

95
lisp/progmodes/python.el
View File

@ -579,6 +579,33 @@ having to restart the program."
"Queue of Python temp files awaiting execution.
Currently-active file is at the head of the list.")
(defcustom python-shell-prompt-alist
'(("ipython" . "^In \\[[0-9]+\\]: *")
(t . "^>>> "))
"Alist of Python input prompts.
Each element has the form (PROGRAM . REGEXP), where PROGRAM is
the value of `python-python-command' for the python process and
REGEXP is a regular expression matching the Python prompt.
PROGRAM can also be t, which specifies the default when no other
element matches `python-python-command'."
:type 'string
:group 'python
:version "24.1")
(defcustom python-shell-continuation-prompt-alist
'(("ipython" . "^ [.][.][.]+: *")
(t . "^[.][.][.] "))
"Alist of Python continued-line prompts.
Each element has the form (PROGRAM . REGEXP), where PROGRAM is
the value of `python-python-command' for the python process and
REGEXP is a regular expression matching the Python prompt for
continued lines.
PROGRAM can also be t, which specifies the default when no other
element matches `python-python-command'."
:type 'string
:group 'python
:version "24.1")
(defvar python-pdbtrack-is-tracking-p nil)
(defconst python-pdbtrack-stack-entry-regexp
@ -1311,13 +1338,9 @@ See `python-check-command' for the default."
;;;; Inferior mode stuff (following cmuscheme).
;; Fixme: Make sure we can work with IPython.
(defcustom python-python-command "python"
"Shell command to run Python interpreter.
Any arguments can't contain whitespace.
Note that IPython may not work properly; it must at least be used
with the `-cl' flag, i.e. use `ipython -cl'."
Any arguments can't contain whitespace."
:group 'python
:type 'string)
@ -1395,6 +1418,23 @@ local value.")
;; Autoloaded.
(declare-function compilation-shell-minor-mode "compile" (&optional arg))
(defvar python--prompt-regexp nil)
(defun python--set-prompt-regexp ()
(let ((prompt (cdr-safe (or (assoc python-python-command
python-shell-prompt-alist)
(assq t python-shell-prompt-alist))))
(cprompt (cdr-safe (or (assoc python-python-command
python-shell-continuation-prompt-alist)
(assq t python-shell-continuation-prompt-alist)))))
(set (make-local-variable 'comint-prompt-regexp)
(concat "\\("
(mapconcat 'identity
(delq nil (list prompt cprompt "^([Pp]db) "))
"\\|")
"\\)"))
(set (make-local-variable 'python--prompt-regexp) prompt)))
;; Fixme: This should inherit some stuff from `python-mode', but I'm
;; not sure how much: at least some keybindings, like C-c C-f;
;; syntax?; font-locking, e.g. for triple-quoted strings?
@ -1417,14 +1457,12 @@ For running multiple processes in multiple buffers, see `run-python' and
\\{inferior-python-mode-map}"
:group 'python
(require 'ansi-color) ; for ipython
(setq mode-line-process '(":%s"))
(set (make-local-variable 'comint-input-filter) 'python-input-filter)
(add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter
nil t)
;; Still required by `comint-redirect-send-command', for instance
;; (and we need to match things like `>>> ... >>> '):
(set (make-local-variable 'comint-prompt-regexp)
(rx line-start (1+ (and (or (repeat 3 (any ">.")) "(Pdb)") " "))))
(python--set-prompt-regexp)
(set (make-local-variable 'compilation-error-regexp-alist)
python-compilation-regexp-alist)
(compilation-shell-minor-mode 1))
@ -1521,12 +1559,12 @@ Don't save anything for STR matching `inferior-python-filter-regexp'."
cmd)))
(unless (shell-command-to-string cmd)
(error "Can't run Python command `%s'" cmd))
(let* ((res (shell-command-to-string (concat cmd " --version"))))
(string-match "Python \\([0-9]\\)\\.\\([0-9]\\)" res)
(unless (and (equal "2" (match-string 1 res))
(match-beginning 2)
(>= (string-to-number (match-string 2 res)) 2))
(error "Only Python versions >= 2.2 and < 3.0 supported")))
(let* ((res (shell-command-to-string
(concat cmd
" -c \"from sys import version_info;\
print version_info >= (2, 2) and version_info < (3, 0)\""))))
(unless (string-match "True" res)
(error "Only Python versions >= 2.2 and < 3.0 are supported")))
(setq python-version-checked t)))
;;;###autoload
@ -1549,6 +1587,7 @@ buffer for a list of commands.)"
(interactive (if current-prefix-arg
(list (read-string "Run Python: " python-command) nil t)
(list python-command)))
(require 'ansi-color) ; for ipython
(unless cmd (setq cmd python-command))
(python-check-version cmd)
(setq python-command cmd)
@ -1566,8 +1605,10 @@ buffer for a list of commands.)"
(if path (concat path path-separator))
data-directory)
process-environment))
;; Suppress use of pager for help output:
(process-connection-type nil))
;; If we use a pipe, unicode characters are not printed
;; correctly (Bug#5794) and IPython does not work at
;; all (Bug#5390).
(process-connection-type t))
(apply 'make-comint-in-buffer "Python"
(generate-new-buffer "*Python*")
(car cmdlist) nil (cdr cmdlist)))
@ -1623,7 +1664,12 @@ buffer for a list of commands.)"
;; non-ASCII.
(interactive "r")
(let* ((f (make-temp-file "py"))
(command (format "emacs.eexecfile(%S)" f))
(command
;; IPython puts the FakeModule module into __main__ so
;; emacs.eexecfile becomes useless.
(if (string-match "^ipython" python-command)
(format "execfile %S" f)
(format "emacs.eexecfile(%S)" f)))
(orig-start (copy-marker start)))
(when (save-excursion
(goto-char start)
@ -1823,7 +1869,9 @@ If there isn't, it's probably not appropriate to send input to return Eldoc
information etc. If PROC is non-nil, check the buffer for that process."
(with-current-buffer (process-buffer (or proc (python-proc)))
(save-excursion
(save-match-data (re-search-backward ">>> \\=" nil t)))))
(save-match-data
(re-search-backward (concat python--prompt-regexp " *\\=")
nil t)))))
;; Fixme: Is there anything reasonable we can do with random methods?
;; (Currently only works with functions.)
@ -2539,9 +2587,7 @@ Runs `jython-mode-hook' after `python-mode-hook'."
"Watch output for Python prompt and exec next file waiting in queue.
This function is appropriate for `comint-output-filter-functions'."
;; TBD: this should probably use split-string
(when (and (or (string-equal string ">>> ")
(and (>= (length string) 5)
(string-equal (substring string -5) "\n>>> ")))
(when (and (string-match python--prompt-regexp string)
python-file-queue)
(condition-case nil
(delete-file (car python-file-queue))
@ -2753,6 +2799,7 @@ comint believe the user typed this string so that
(funcall (process-filter proc) proc msg))
(set-buffer curbuf))
(process-send-string proc cmd)))
;;;###autoload
(defun python-shell (&optional argprompt)
"Start an interactive Python interpreter in another window.
@ -2792,6 +2839,7 @@ interaction between undo and process filters; the same problem exists in
non-Python process buffers using the default (Emacs-supplied) process
filter."
(interactive "P")
(require 'ansi-color) ; For ipython
;; Set the default shell if not already set
(when (null python-which-shell)
(python-toggle-shells python-default-interpreter))
@ -2808,10 +2856,9 @@ filter."
))))
(switch-to-buffer-other-window
(apply 'make-comint python-which-bufname python-which-shell nil args))
(make-local-variable 'comint-prompt-regexp)
(set-process-sentinel (get-buffer-process (current-buffer))
'python-sentinel)
(setq comint-prompt-regexp "^>>> \\|^[.][.][.] \\|^(pdb) ")
(python--set-prompt-regexp)
(add-hook 'comint-output-filter-functions
'python-comint-output-filter-function nil t)
;; pdbtrack

5
lisp/progmodes/ruby-mode.el
View File

@ -43,6 +43,11 @@
(eval-when-compile (require 'cl))
(defgroup ruby nil
"Major mode for editing Ruby code."
:prefix "ruby-"
:group 'languages)
(defconst ruby-keyword-end-re
(if (string-match "\\_>" "ruby")
"\\_>"

41
lisp/simple.el
View File

@ -1301,6 +1301,40 @@ to get different commands to edit and resubmit."
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
(defun read-extended-command ()
"Read command name to invoke in `execute-extended-command'."
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
(lambda ()
;; Get a command name at point in the original buffer
;; to propose it after M-n.
(with-current-buffer (window-buffer (minibuffer-selected-window))
(and (commandp (function-called-at-point))
(format "%S" (function-called-at-point)))))))
;; Read a string, completing from and restricting to the set of
;; all defined commands. Don't provide any initial input.
;; Save the command read on the extended-command history list.
(completing-read
(concat (cond
((eq current-prefix-arg '-) "- ")
((and (consp current-prefix-arg)
(eq (car current-prefix-arg) 4)) "C-u ")
((and (consp current-prefix-arg)
(integerp (car current-prefix-arg)))
(format "%d " (car current-prefix-arg)))
((integerp current-prefix-arg)
(format "%d " current-prefix-arg)))
;; This isn't strictly correct if `execute-extended-command'
;; is bound to anything else (e.g. [menu]).
;; It could use (key-description (this-single-command-keys)),
;; but actually a prompt other than "M-x" would be confusing,
;; because "M-x" is a well-known prompt to read a command
;; and it serves as a shorthand for "Extended command: ".
"M-x ")
obarray 'commandp t nil 'extended-command-history)))
(defvar minibuffer-history nil
"Default minibuffer history list.
@ -3103,7 +3137,8 @@ If the buffer is read-only, Emacs will beep and refrain from deleting
the text, but put the text in the kill ring anyway. This means that
you can use the killing commands to copy text from a read-only buffer.
This is the primitive for programs to kill text (as opposed to deleting it).
Lisp programs should use this function for killing text.
(To delete text, use `delete-region'.)
Supply two arguments, character positions indicating the stretch of text
to be killed.
Any command that calls this function is a \"kill command\".
@ -5495,7 +5530,9 @@ it skips the contents of comments that end before point."
(and parse-sexp-ignore-comments
(not blink-matching-paren-dont-ignore-comments))))
(condition-case ()
(scan-sexps oldpos -1)
(progn
(forward-sexp -1)
(point))
(error nil))))))
(matching-paren
(and blinkpos

24
lisp/startup.el
View File

@ -785,15 +785,16 @@ opening the first frame (e.g. open a connection to an X server).")
argi (match-string 1 argi)))
(when (string-match "\\`--." orig-argi)
(let ((completion (try-completion argi longopts)))
(if (eq completion t)
(setq argi (substring argi 1))
(if (stringp completion)
(let ((elt (assoc completion longopts)))
(or elt
(error "Option `%s' is ambiguous" argi))
(setq argi (substring (car elt) 1)))
(setq argval nil
argi orig-argi)))))
(cond ((eq completion t)
(setq argi (substring argi 1)))
((stringp completion)
(let ((elt (assoc completion longopts)))
(unless elt
(error "Option `%s' is ambiguous" argi))
(setq argi (substring (car elt) 1))))
(t
(setq argval nil
argi orig-argi)))))
(cond
;; The --display arg is handled partly in C, partly in Lisp.
;; When it shows up here, we just put it back to be handled
@ -2231,6 +2232,11 @@ A fancy display is used on graphic displays, normal otherwise."
(move-to-column (1- cl1-column)))
(setq cl1-column 0))
;; These command lines now have no effect.
((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
(display-warning 'initialization
(format "Ignoring obsolete arg %s" argi)))
((equal argi "--")
(setq just-files t))
(t

9
lisp/subr.el
View File

@ -219,6 +219,7 @@ Treated as a declaration when used at the right place in a
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
Otherwise, return result of last form in BODY."
(declare (debug t) (indent 0))
`(condition-case nil (progn ,@body) (error nil)))
;;;; Basic Lisp functions.
@ -1818,6 +1819,7 @@ When there's an ambiguity because the key looks like the prefix of
some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(let ((overriding-terminal-local-map read-key-empty-map)
(overriding-local-map nil)
(echo-keystrokes 0)
(old-global-map (current-global-map))
(timer (run-with-idle-timer
;; Wait long enough that Emacs has the time to receive and
@ -1842,7 +1844,12 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(throw 'read-key keys)))))))
(unwind-protect
(progn
(use-global-map read-key-empty-map)
(use-global-map
(let ((map (make-sparse-keymap)))
;; Don't hide the menu-bar and tool-bar entries.
(define-key map [menu-bar] (lookup-key global-map [menu-bar]))
(define-key map [tool-bar] (lookup-key global-map [tool-bar]))
map))
(aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
(cancel-timer timer)
(use-global-map old-global-map))))

6
lisp/textmodes/flyspell.el
View File

@ -199,9 +199,9 @@ Ispell's ultimate default dictionary."
(defcustom flyspell-check-tex-math-command nil
"Non-nil means check even inside TeX math environment.
TeX math environments are discovered by the TEXMATHP that implemented
inside the texmathp.el Emacs package. That package may be found at:
http://strw.leidenuniv.nl/~dominik/Tools"
TeX math environments are discovered by `texmathp', implemented
inside AUCTeX package. That package may be found at
URL `http://www.gnu.org/software/auctex/'"
:group 'flyspell
:type 'boolean)

12
lisp/vc/add-log.el
View File

@ -755,7 +755,17 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
(if add-log-file-name-function
(funcall add-log-file-name-function buffer-file)
(setq buffer-file
(file-relative-name buffer-file (file-name-directory log-file)))
(let* ((dir (file-name-directory log-file))
(rel (file-relative-name buffer-file dir)))
;; Sometimes with symlinks, the two buffers may have names that
;; appear to belong to different directory trees. So check the
;; file-truenames, to see if we get a better result.
(if (not (string-match "\\`\\.\\./" rel))
rel
(let ((new (file-relative-name (file-truename buffer-file)
(file-truename dir))))
(if (< (length new) (length rel))
new rel)))))
;; If we have a backup file, it's presumably because we're
;; comparing old and new versions (e.g. for deleted
;; functions) and we'll want to use the original name.

352
lisp/whitespace.el
View File

@ -6,7 +6,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: data, wp
;; Version: 12.1
;; Version: 13.1
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@ -382,19 +382,28 @@
(defcustom whitespace-style
'(tabs spaces trailing lines space-before-tab newline
indentation empty space-after-tab
space-mark tab-mark newline-mark)
'(face
tabs spaces trailing lines space-before-tab newline
indentation empty space-after-tab
space-mark tab-mark newline-mark)
"Specify which kind of blank is visualized.
It's a list containing some or all of the following values:
face enable all visualization via faces (see below).
trailing trailing blanks are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
tabs TABs are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
spaces SPACEs and HARD SPACEs are visualized via
faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
lines lines which have columns beyond
`whitespace-line-column' are highlighted via
@ -402,6 +411,8 @@ It's a list containing some or all of the following values:
Whole line is highlighted.
It has precedence over `lines-tail' (see
below).
It has effect only if `face' (see above)
is present in `whitespace-style'.
lines-tail lines which have columns beyond
`whitespace-line-column' are highlighted via
@ -409,45 +420,69 @@ It's a list containing some or all of the following values:
But only the part of line which goes
beyond `whitespace-line-column' column.
It has effect only if `lines' (see above)
is not present in `whitespace-style'.
is not present in `whitespace-style'
and if `face' (see above) is present in
`whitespace-style'.
newline NEWLINEs are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
empty empty lines at beginning and/or end of buffer
are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
indentation::tab 8 or more SPACEs at beginning of line are
visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
indentation::space TABs at beginning of line are visualized via
faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
indentation 8 or more SPACEs at beginning of line are
visualized, if `indent-tabs-mode' (which see)
is non-nil; otherwise, TABs at beginning of
line are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-after-tab::tab 8 or more SPACEs after a TAB are
visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-after-tab::space TABs are visualized when 8 or more
SPACEs occur after a TAB, via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-after-tab 8 or more SPACEs after a TAB are
visualized, if `indent-tabs-mode'
(which see) is non-nil; otherwise,
the TABs are visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-before-tab::tab SPACEs before TAB are visualized via
faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-before-tab::space TABs are visualized when SPACEs occur
before TAB, via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-before-tab SPACEs before TAB are visualized, if
`indent-tabs-mode' (which see) is
non-nil; otherwise, the TABs are
visualized via faces.
It has effect only if `face' (see above)
is present in `whitespace-style'.
space-mark SPACEs and HARD SPACEs are visualized via
display table.
@ -486,6 +521,11 @@ So, for example, if indentation and indentation::space are
included in `whitespace-style' list, the indentation value is
evaluated instead of indentation::space value.
One reason for not visualize spaces via faces (if `face' is not
included in `whitespace-style') is to use exclusively for
cleanning up a buffer. See `whitespace-cleanup' and
`whitespace-cleanup-region' for documentation.
See also `whitespace-display-mappings' for documentation."
:type '(repeat :tag "Kind of Blank"
(choice :tag "Kind of Blank Face"
@ -521,9 +561,9 @@ Used when `whitespace-style' includes the value `spaces'."
(defface whitespace-space
'((((class color) (background dark))
(:background "grey20" :foreground "aquamarine3"))
(:background "grey20" :foreground "darkgray"))
(((class color) (background light))
(:background "LightYellow" :foreground "aquamarine3"))
(:background "LightYellow" :foreground "lightgray"))
(t (:inverse-video t)))
"Face used to visualize SPACE."
:group 'whitespace)
@ -539,9 +579,9 @@ Used when `whitespace-style' includes the value `spaces'."
(defface whitespace-hspace ; 'nobreak-space
'((((class color) (background dark))
(:background "grey24" :foreground "aquamarine3"))
(:background "grey24" :foreground "darkgray"))
(((class color) (background light))
(:background "LemonChiffon3" :foreground "aquamarine3"))
(:background "LemonChiffon3" :foreground "lightgray"))
(t (:inverse-video t)))
"Face used to visualize HARD SPACE."
:group 'whitespace)
@ -557,9 +597,9 @@ Used when `whitespace-style' includes the value `tabs'."
(defface whitespace-tab
'((((class color) (background dark))
(:background "grey22" :foreground "aquamarine3"))
(:background "grey22" :foreground "darkgray"))
(((class color) (background light))
(:background "beige" :foreground "aquamarine3"))
(:background "beige" :foreground "lightgray"))
(t (:inverse-video t)))
"Face used to visualize TAB."
:group 'whitespace)
@ -812,7 +852,7 @@ Used when `whitespace-style' includes `indentation',
:group 'whitespace)
(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
(defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)"
"Specify regexp for empty lines at beginning of buffer.
If you're using `mule' package, there may be other characters besides:
@ -827,7 +867,7 @@ Used when `whitespace-style' includes `empty'."
:group 'whitespace)
(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)"
"Specify regexp for empty lines at end of buffer.
If you're using `mule' package, there may be other characters besides:
@ -866,8 +906,13 @@ Used when `whitespace-style' includes `space-after-tab',
(defcustom whitespace-line-column 80
"Specify column beyond which the line is highlighted.
It must be an integer or nil. If nil, the `fill-column' variable value is
used.
Used when `whitespace-style' includes `lines' or `lines-tail'."
:type '(integer :tag "Line Length")
:type '(choice :tag "Line Length Limit"
(integer :tag "Line Length")
(const :tag "Use fill-column" nil))
:group 'whitespace)
@ -1151,7 +1196,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
(defconst whitespace-style-value-list
'(tabs
'(face
tabs
spaces
trailing
lines
@ -1176,7 +1222,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
(defconst whitespace-toggle-option-alist
'((?t . tabs)
'((?f . face)
(?t . tabs)
(?s . spaces)
(?r . trailing)
(?l . lines)
@ -1228,6 +1275,19 @@ Used by `whitespace-trailing-regexp' function (which see).")
"Used to save locally the font-lock refontify state.
Used by `whitespace-post-command-hook' function (which see).")
(defvar whitespace-bob-marker nil
"Used to save locally the bob marker value.
Used by `whitespace-post-command-hook' function (which see).")
(defvar whitespace-eob-marker nil
"Used to save locally the eob marker value.
Used by `whitespace-post-command-hook' function (which see).")
(defvar whitespace-buffer-changed nil
"Used to indicate locally if buffer changed.
Used by `whitespace-post-command-hook' and `whitespace-buffer-changed'
functions (which see).")
;;;###autoload
(defun whitespace-toggle-options (arg)
@ -1243,6 +1303,7 @@ Interactively, it reads one of the following chars:
CHAR MEANING
(VIA FACES)
f toggle face visualization
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
@ -1271,6 +1332,7 @@ Interactively, it reads one of the following chars:
Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:
face toggle face visualization
tabs toggle TAB visualization
spaces toggle SPACE and HARD SPACE visualization
trailing toggle trailing blanks visualization
@ -1320,6 +1382,7 @@ Interactively, it accepts one of the following chars:
CHAR MEANING
(VIA FACES)
f toggle face visualization
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
@ -1348,6 +1411,7 @@ Interactively, it accepts one of the following chars:
Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:
face toggle face visualization
tabs toggle TAB visualization
spaces toggle SPACE and HARD SPACE visualization
trailing toggle trailing blanks visualization
@ -1463,10 +1527,10 @@ documentation."
(let (overwrite-mode) ; enforce no overwrite
(goto-char (point-min))
(when (re-search-forward
whitespace-empty-at-bob-regexp nil t)
(concat "\\`" whitespace-empty-at-bob-regexp) nil t)
(delete-region (match-beginning 1) (match-end 1)))
(when (re-search-forward
whitespace-empty-at-eob-regexp nil t)
(concat whitespace-empty-at-eob-regexp "\\'") nil t)
(delete-region (match-beginning 1) (match-end 1)))))))
;; PROBLEM 3: 8 or more SPACEs at bol
;; PROBLEM 4: SPACEs before TAB
@ -1877,9 +1941,10 @@ cleaning up these problems."
(defconst whitespace-help-text
"\
Whitespace Toggle Options
FACES
Whitespace Toggle Options | scroll up : SPC or > |
| scroll down: M-SPC or < |
FACES \\__________________________/
[] f - toggle face visualization
[] t - toggle TAB visualization
[] s - toggle SPACE and HARD SPACE visualization
[] r - toggle trailing blanks visualization
@ -1953,15 +2018,13 @@ cleaning up these problems."
"Display BUFFER in a new window."
(goto-char (point-min))
(set-buffer-modified-p nil)
(let ((size (- (window-height)
(max window-min-height
(1+ (count-lines (point-min)
(point-max)))))))
(when (<= size 0)
(kill-buffer buffer)
(error "Frame height is too small; \
(when (< (window-height) (* 2 window-min-height))
(kill-buffer buffer)
(error "Window height is too small; \
can't split window to display whitespace toggle options"))
(set-window-buffer (split-window nil size) buffer)))
(let ((win (split-window)))
(set-window-buffer win buffer)
(shrink-window-if-larger-than-buffer win)))
(defun whitespace-kill-buffer (buffer-name)
@ -1977,6 +2040,24 @@ can't split window to display whitespace toggle options"))
(whitespace-kill-buffer whitespace-help-buffer-name))
(defun whitespace-help-scroll (&optional up)
"Scroll help window, if it exists.
If UP is non-nil, scroll up; otherwise, scroll down."
(condition-case data-help
(let ((buffer (get-buffer whitespace-help-buffer-name)))
(if buffer
(with-selected-window (get-buffer-window buffer)
(if up
(scroll-up 3)
(scroll-down 3)))
(ding)))
;; handler
((error)
;; just ignore error
)))
(defun whitespace-interactive-char (local-p)
"Interactive function to read a char and return a symbol.
@ -1987,6 +2068,7 @@ It accepts one of the following chars:
CHAR MEANING
(VIA FACES)
f toggle face visualization
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
@ -2036,9 +2118,13 @@ See also `whitespace-toggle-option-alist'."
(cdr
(assq ch whitespace-toggle-option-alist)))))
;; while body
(if (eq ch ?\?)
(whitespace-help-on style)
(ding)))
(cond
((eq ch ?\?) (whitespace-help-on style))
((eq ch ?\ ) (whitespace-help-scroll t))
((eq ch ?\M- ) (whitespace-help-scroll))
((eq ch ?>) (whitespace-help-scroll t))
((eq ch ?<) (whitespace-help-scroll))
(t (ding))))
(whitespace-help-off)
(message " ")) ; clean echo area
;; handler
@ -2117,22 +2203,23 @@ resultant list will be returned."
(defun whitespace-style-face-p ()
"Return t if there is some visualization via face."
(or (memq 'tabs whitespace-active-style)
(memq 'spaces whitespace-active-style)
(memq 'trailing whitespace-active-style)
(memq 'lines whitespace-active-style)
(memq 'lines-tail whitespace-active-style)
(memq 'newline whitespace-active-style)
(memq 'empty whitespace-active-style)
(memq 'indentation whitespace-active-style)
(memq 'indentation::tab whitespace-active-style)
(memq 'indentation::space whitespace-active-style)
(memq 'space-after-tab whitespace-active-style)
(memq 'space-after-tab::tab whitespace-active-style)
(memq 'space-after-tab::space whitespace-active-style)
(memq 'space-before-tab whitespace-active-style)
(memq 'space-before-tab::tab whitespace-active-style)
(memq 'space-before-tab::space whitespace-active-style)))
(and (memq 'face whitespace-active-style)
(or (memq 'tabs whitespace-active-style)
(memq 'spaces whitespace-active-style)
(memq 'trailing whitespace-active-style)
(memq 'lines whitespace-active-style)
(memq 'lines-tail whitespace-active-style)
(memq 'newline whitespace-active-style)
(memq 'empty whitespace-active-style)
(memq 'indentation whitespace-active-style)
(memq 'indentation::tab whitespace-active-style)
(memq 'indentation::space whitespace-active-style)
(memq 'space-after-tab whitespace-active-style)
(memq 'space-after-tab::tab whitespace-active-style)
(memq 'space-after-tab::space whitespace-active-style)
(memq 'space-before-tab whitespace-active-style)
(memq 'space-before-tab::tab whitespace-active-style)
(memq 'space-before-tab::space whitespace-active-style))))
(defun whitespace-color-on ()
@ -2146,8 +2233,15 @@ resultant list will be returned."
(set (make-local-variable 'whitespace-point)
(point))
(set (make-local-variable 'whitespace-font-lock-refontify)
0)
(set (make-local-variable 'whitespace-bob-marker)
(point-min-marker))
(set (make-local-variable 'whitespace-eob-marker)
(point-max-marker))
(set (make-local-variable 'whitespace-buffer-changed)
nil)
(add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
(add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
;; turn off font lock
(set (make-local-variable 'whitespace-font-lock-mode)
font-lock-mode)
@ -2158,7 +2252,7 @@ resultant list will be returned."
nil
(list
;; Show SPACEs
(list #'whitespace-space-regexp 1 whitespace-space t)
(list whitespace-space-regexp 1 whitespace-space t)
;; Show HARD SPACEs
(list whitespace-hspace-regexp 1 whitespace-hspace t))
t))
@ -2167,7 +2261,7 @@ resultant list will be returned."
nil
(list
;; Show TABs
(list #'whitespace-tab-regexp 1 whitespace-tab t))
(list whitespace-tab-regexp 1 whitespace-tab t))
t))
(when (memq 'trailing whitespace-active-style)
(font-lock-add-keywords
@ -2183,14 +2277,16 @@ resultant list will be returned."
(list
;; Show "long" lines
(list
(format
"^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
whitespace-tab-width (1- whitespace-tab-width)
(/ whitespace-line-column whitespace-tab-width)
(let ((rem (% whitespace-line-column whitespace-tab-width)))
(if (zerop rem)
""
(format ".\\{%d\\}" rem))))
(let ((line-column (or whitespace-line-column fill-column)))
(format
"^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
whitespace-tab-width
(1- whitespace-tab-width)
(/ line-column whitespace-tab-width)
(let ((rem (% line-column whitespace-tab-width)))
(if (zerop rem)
""
(format ".\\{%d\\}" rem)))))
(if (memq 'lines whitespace-active-style)
0 ; whole line
2) ; line tail
@ -2296,7 +2392,8 @@ resultant list will be returned."
;; turn off font lock
(when (whitespace-style-face-p)
(font-lock-mode 0)
(remove-hook 'post-command-hook #'whitespace-post-command-hook)
(remove-hook 'post-command-hook #'whitespace-post-command-hook t)
(remove-hook 'before-change-functions #'whitespace-buffer-changed t)
(when whitespace-font-lock
(setq whitespace-font-lock nil
font-lock-keywords whitespace-font-lock-keywords))
@ -2317,37 +2414,128 @@ resultant list will be returned."
(defun whitespace-empty-at-bob-regexp (limit)
"Match spaces at beginning of buffer which do not contain the point at \
beginning of buffer."
(and (/= whitespace-point 1)
(re-search-forward whitespace-empty-at-bob-regexp limit t)))
(let ((b (point))
r)
(cond
;; at bob
((= b 1)
(setq r (and (/= whitespace-point 1)
(looking-at whitespace-empty-at-bob-regexp)))
(if r
(set-marker whitespace-bob-marker (match-end 1))
(set-marker whitespace-bob-marker b)))
;; inside bob empty region
((<= limit whitespace-bob-marker)
(setq r (looking-at whitespace-empty-at-bob-regexp))
(if r
(when (< (match-end 1) limit)
(set-marker whitespace-bob-marker (match-end 1)))
(set-marker whitespace-bob-marker b)))
;; intersection with end of bob empty region
((<= b whitespace-bob-marker)
(setq r (looking-at whitespace-empty-at-bob-regexp))
(if r
(set-marker whitespace-bob-marker (match-end 1))
(set-marker whitespace-bob-marker b)))
;; it is not inside bob empty region
(t
(setq r nil)))
;; move to end of matching
(and r (goto-char (match-end 1)))
r))
(defsubst whitespace-looking-back (regexp limit)
(save-excursion
(when (/= 0 (skip-chars-backward " \t\n" limit))
(unless (bolp)
(forward-line 1))
(looking-at regexp))))
(defun whitespace-empty-at-eob-regexp (limit)
"Match spaces at end of buffer which do not contain the point at end of \
buffer."
(and (/= whitespace-point (1+ (buffer-size)))
(re-search-forward whitespace-empty-at-eob-regexp limit t)))
(let ((b (point))
(e (1+ (buffer-size)))
r)
(cond
;; at eob
((= limit e)
(when (/= whitespace-point e)
(goto-char limit)
(setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)))
(if r
(set-marker whitespace-eob-marker (match-beginning 1))
(set-marker whitespace-eob-marker limit)
(goto-char b))) ; return back to initial position
;; inside eob empty region
((>= b whitespace-eob-marker)
(goto-char limit)
(setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
(if r
(when (> (match-beginning 1) b)
(set-marker whitespace-eob-marker (match-beginning 1)))
(set-marker whitespace-eob-marker limit)
(goto-char b))) ; return back to initial position
;; intersection with beginning of eob empty region
((>= limit whitespace-eob-marker)
(goto-char limit)
(setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
(if r
(set-marker whitespace-eob-marker (match-beginning 1))
(set-marker whitespace-eob-marker limit)
(goto-char b))) ; return back to initial position
;; it is not inside eob empty region
(t
(setq r nil)))
r))
(defun whitespace-space-regexp (limit)
"Match spaces."
(setq whitespace-font-lock-refontify t)
(re-search-forward whitespace-space-regexp limit t))
(defun whitespace-tab-regexp (limit)
"Match tabs."
(setq whitespace-font-lock-refontify t)
(re-search-forward whitespace-tab-regexp limit t))
(defun whitespace-buffer-changed (beg end)
"Set `whitespace-buffer-changed' variable to t."
(setq whitespace-buffer-changed t))
(defun whitespace-post-command-hook ()
"Save current point into `whitespace-point' variable.
Also refontify when necessary."
(setq whitespace-point (point))
(let ((refontify (or (eolp) ; end of line
(= whitespace-point 1)))) ; beginning of buffer
(when (or whitespace-font-lock-refontify refontify)
(setq whitespace-font-lock-refontify refontify)
(setq whitespace-point (point)) ; current point position
(let ((refontify
(or
;; it is at end of line ...
(and (eolp)
;; ... with trailing SPACE or TAB
(or (= (preceding-char) ?\ )
(= (preceding-char) ?\t)))
;; it is at beginning of buffer (bob)
(= whitespace-point 1)
;; the buffer was modified and ...
(and whitespace-buffer-changed
(or
;; ... or inside bob whitespace region
(<= whitespace-point whitespace-bob-marker)
;; ... or at bob whitespace region border
(and (= whitespace-point (1+ whitespace-bob-marker))
(= (preceding-char) ?\n))))
;; it is at end of buffer (eob)
(= whitespace-point (1+ (buffer-size)))
;; the buffer was modified and ...
(and whitespace-buffer-changed
(or
;; ... or inside eob whitespace region
(>= whitespace-point whitespace-eob-marker)
;; ... or at eob whitespace region border
(and (= whitespace-point (1- whitespace-eob-marker))
(= (following-char) ?\n)))))))
(when (or refontify (> whitespace-font-lock-refontify 0))
(setq whitespace-buffer-changed nil)
;; adjust refontify counter
(setq whitespace-font-lock-refontify
(if refontify
1
(1- whitespace-font-lock-refontify)))
;; refontify
(jit-lock-refontify))))
@ -2386,11 +2574,11 @@ Also refontify when necessary."
(unless whitespace-display-table-was-local
(setq whitespace-display-table-was-local t
whitespace-display-table
(copy-sequence buffer-display-table))
;; asure `buffer-display-table' is unique
;; when two or more windows are visible.
(setq buffer-display-table
(copy-sequence buffer-display-table)))
;; asure `buffer-display-table' is unique
;; when two or more windows are visible.
(set (make-local-variable 'buffer-display-table)
(copy-sequence buffer-display-table))
(unless buffer-display-table
(setq buffer-display-table (make-display-table)))
(dolist (entry whitespace-display-mappings)

5
lisp/woman.el
View File

@ -3388,7 +3388,10 @@ Format paragraphs upto TO. Supports special chars.
"Translate up to marker TO. Do this last of all transformations."
(if translations
(let ((matches (car translations))
(alist (cdr translations)))
(alist (cdr translations))
;; Translations are case-sensitive, eg ".tr ab" does not
;; affect "A" (bug#6849).
(case-fold-search nil))
(while (re-search-forward matches to t)
;; Done like this to retain text properties and
;; support translation of special characters:

8
msdos/ChangeLog
View File

@ -1,3 +1,11 @@
2010-08-20 Eli Zaretskii <eliz@gnu.org>
* sed1v2.inp (IMAGEMAGICK_LIBS, IMAGEMAGICK_CFLAGS): Edit to empty.
2010-08-15 Eli Zaretskii <eliz@gnu.org>
* mainmake.v2 (version): Update due to change in emacs.c.
2010-08-05 Eli Zaretskii <eliz@gnu.org>
* sed1v2.inp (UNEXEC_OBJ): Edit to unexcoff.o, due to renaming of

2
msdos/mainmake.v2
View File

@ -65,7 +65,7 @@ MAKESHELL=/xyzzy/command
top_srcdir := $(subst \,/,$(shell cd))
# Find out which version of Emacs this is.
version := ${shell sed -n -e '/^const char emacs_version/s/^[^"]*\("[^"]*"\).*/\1/p' src/emacs.c}
version := ${shell sed -n -e '/^static const char emacs_version/s/^[^"]*\("[^"]*"\).*/\1/p' src/emacs.c}
# Q: Do we need to bootstrap?
# A: Only if we find admin/admin.el, i.e. we are building out of

2
msdos/sed1v2.inp
View File

@ -88,6 +88,8 @@ s/\.h\.in/.h-in/
/^CFLAGS_SOUND *=/s/@CFLAGS_SOUND@//
/^RSVG_LIBS *=/s/@RSVG_LIBS@//
/^RSVG_CFLAGS *=/s/@RSVG_CFLAGS@//
/^IMAGEMAGICK_LIBS *=/s/@IMAGEMAGICK_LIBS@//
/^IMAGEMAGICK_CFLAGS *=/s/@IMAGEMAGICK_CFLAGS@//
/^WIDGET_OBJ *=/s/@WIDGET_OBJ@//
/^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@//
/^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/

2
msdos/sedleim.inp
View File

@ -34,7 +34,7 @@ s|\([ ]\)echo|\1djecho|g
/RUN-EMACS *=/,/^$/c\
export EMACSLOADPATH=${buildlisppath}\
RUN-EMACS = ${BUILT-EMACS} -batch --no-init-file --no-site-file --multibyte
RUN-EMACS = ${BUILT-EMACS} -batch --no-init-file --no-site-file
/^ cd ../c\
${MAKE} -C ../src ${MFLAGS} emacs

4
nt/ChangeLog
View File

@ -1,3 +1,7 @@
2010-08-19 Juanma Barranquero <lekktu@gmail.com>
* addpm.c (add_registry): Create App Paths of type REG_EXPAND_SZ.
2010-08-12 Jason Rumney <jasonr@gnu.org>
* addpm.c (add_registry): Set path for runemacs.exe to use.

7
nt/addpm.c
View File

@ -113,7 +113,7 @@ add_registry (char *path)
emacs_path = (char *) alloca (len);
sprintf (emacs_path, "%s\\bin\\emacs.exe", path);
RegSetValueEx (hrootkey, NULL, 0, REG_SZ, emacs_path, len);
RegSetValueEx (hrootkey, NULL, 0, REG_EXPAND_SZ, emacs_path, len);
/* Look for a GTK installation. If found, add it to the library search
path for Emacs so that the image libraries it provides are available
@ -135,7 +135,8 @@ add_registry (char *path)
len = strlen (path) + 5 + size;
dll_paths = (char *) alloca (size + strlen (path) + 1);
sprintf (dll_paths, "%s\\bin;%s", path, gtk_path);
RegSetValueEx (hrootkey, "Path", 0, REG_SZ, dll_paths, len);
RegSetValueEx (hrootkey, "Path", 0, REG_EXPAND_SZ,
dll_paths, len);
/* Set the same path for runemacs.exe, as the Explorer shell
looks this up, so the above does not take effect when
@ -145,7 +146,7 @@ add_registry (char *path)
KEY_WRITE, NULL, &runemacs_key, NULL)
== ERROR_SUCCESS)
{
RegSetValueEx (runemacs_key, "Path", 0, REG_SZ,
RegSetValueEx (runemacs_key, "Path", 0, REG_EXPAND_SZ,
dll_paths, len);
RegCloseKey (runemacs_key);

198
src/ChangeLog
View File

@ -1,3 +1,186 @@
2010-08-25 Kenichi Handa <handa@m17n.org>
* composite.c (composition_compute_stop_pos): Don't break
composition at PT.
(composition_reseat_it): Likewise. Fix calculation of character
position starting a composition.
(Fcomposition_get_gstring): Don't limit the number of components
for automatic composition.
2010-08-25 Kenichi Handa <handa@m17n.org>
* composite.c (composition_compute_stop_pos): In forward search,
pay attention to the possibility that some character after ENDPOS
will be composed with charactrs before ENDPOS.
2010-08-24 Chong Yidong <cyd@stupidchicken.com>
* keyboard.c (command_loop_1): Don't clobber primary selection
during handle-switch-frame (Bug#6872).
2010-08-23 Michael Albinus <michael.albinus@gmx.de>
* dbusbind.c: Accept UNIX domain sockets as bus address.
(Fdbus_close_bus): New function.
(Vdbus_registered_buses): New variable.
(xd_initialize): Implement string as bus address.
(Fdbus_init_bus): Add bus to Vdbus_registered_buses).
(Fdbus_get_unique_name, Fdbus_call_method)
(Fdbus_call_method_asynchronously, Fdbus_method_return_internal)
(Fdbus_method_error_internal, Fdbus_send_signal)
(Fdbus_register_signal, Fdbus_register_method): Remove bus type
check. This is done in xd_initialize_bus. Adapt doc string, if
necessary.
(xd_pending_messages, xd_read_queued_messages): Loop over buses in
Vdbus_registered_buses.
(Vdbus_registered_objects_table): Create hash.
2010-08-22 Juri Linkov <juri@jurta.org>
* keyboard.c (Fexecute_extended_command): Move reading a command name
with `completing-read' to a new Elisp function `read-extended-command'.
Call it to read a command to `function' (bug#5364, bug#5214).
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* emacs.c (main): Remove handling of --unibyte arg (Bug#6886).
2010-08-22 Andreas Schwab <schwab@linux-m68k.org>
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP
instead of SAFE_ALLOCA.
2010-08-22 Chong Yidong <cyd@stupidchicken.com>
* eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA
(Bug#6214).
2010-08-22 Jan Djärv <jan.h.d@swipnet.se>
* doc.c (Fsnarf_documentation): Set skip_file only if p[1] is S.
2010-08-22 Jan Djärv <jan.h.d@swipnet.se>
* doc.c (Fsnarf_documentation): Initialize skip_file before
build-files test.
2010-08-22 Peter O'Gorman <pogma@thewrittenword.com> (tiny change)
* s/hpux10-20.h (HAVE_TERMIOS, NO_TERMIO, ORDINARY_LINK):
New definitions.
(HAVE_TERMIO): Remove.
2010-08-22 Eli Zaretskii <eliz@gnu.org>
* deps.mk (sysdep.o, msdos.o): Depend on sysselect.h.
* sysselect.h [WINDOWSNT]: Don't define the FD_* and select stuff
for w32.
* s/ms-w32.h (HAVE_SYS_TIMEB_H): Don't #undef HAVE_SYS_SELECT_H,
it's done in nt/config.nt.
* makefile.w32-in ($(BLD)/sysdep.$(O)): Depend on sysselect.h.
* unexcoff.c (report_error, make_hdr, write_segment)
(copy_text_and_data, copy_sym, mark_x, adjust_lnnoptrs, unexec):
Convert argument lists and prototypes to ANSI C.
(make_hdr, write_segment): Remove unused variables.
(unexec): Remove commented-out line. Initialize `new' to shut up
compiler warnings.
2010-08-22 Dan Nicolaescu <dann@ics.uci.edu>
Simplify termio code.
All non-MSDOS non-WINDOWSNT platforms define HAVE_TERMIOS, so
HAVE_TERMIO code is obsolete.
Replace HAVE_TERMIOS conditionals with !DOS_NT.
* systty.h: Do not define HAVE_TCATTR.
Remove HAVE_TERMIO, HAVE_LTCHARS and HAVE_TCHARS code.
Do not define EMACS_HAVE_TTY_PGRP. Only define
EMACS_GET_TTY_PGRP for !DOS_NT.
* sysdep.c: Include sysselect.h unconditionally. Do not include
sys/ioctl.h and termios.h, systty.h does it. Use
HAVE_SYS_UTSNAME_H instead of USG as an include guard.
(init_baud_rate): Remove HAVE_TERMIO code.
(child_setup_tty): Remove HAVE_TERMIO code.
(emacs_get_tty, emacs_set_tty): Remove HAVE_TERMIO, HAVE_TCHARS
and HAVE_LTCHARS code. Use !DOS_NT instead of HAVE_TCATTR.
(new_ltchars, new_tchars): Remove, unused.
(init_sys_modes): Remove HAVE_TERMIO, HAVE_TCHARS and HAVE_LTCHARS
code. Remove special casing for __mips__, it was a no-op. Remove
HAVE_TCATTR conditional, it is implied by HAVE_TERMIOS.
(init_sys_modes): Remove HPUX special case.
* process.c: Include stdlib.h unconditionally. Do not include
fcntl.h, systty.h does it. Remove conditional code for
HAVE_SERIAL, it is always true.
(process_send_signal): Remove HAVE_TERMIOS conditional, it's
always true when SIGNALS_VIA_CHARACTERS is true.
(Fcontinue_process, Fprocess_send_eof): Simplify conditionals:
!WINDOWSNT means HAVE_TERMIOS.
(create_process): Remove HAVE_TERMIOS, it's inside a HAVE_PTYS
conditional, which is true for all HAVE_TERMIOS systems.
* keyboard.c (init_keyboard): Do not use HAVE_TERMIO, use !DOS_NT
instead of HAVE_TERMIOS.
* emacs.c (shut_down_emacs): Use !defined DOS_NT instead of
EMACS_HAVE_TTY_PGRP.
* callproc.c (child_setup): Move EMACS_SET_TTY_PGRP use to the
non-MSDOS, non-WINDOWSNT code, it's only defined for such systems
anyway.
2010-08-21 Eli Zaretskii <eliz@gnu.org>
* dispnew.c (buffer_posn_from_coords): Fix off-by-one error in
mirroring pixel positions.
2010-08-20 Dan Nicolaescu <dann@ics.uci.edu>
* alloc.c (malloc_sbrk_used, malloc_sbrk_unused): Remove,
write only.
(init_alloc_once): Remove writes to malloc_sbrk_unused, and
malloc_sbrk_used, nothing uses them.
* puresize.h: Remove code assuming PNTR_COMPARISON_TYPE is not
defined, unconditionally defined in lisp.h.
* term.c: Do not include <termios.h>, systty.h does it.
* s/unixware.h (HAVE_TCATTR):
* s/aix4-2.h (HAVE_TCATTR): Remove definitions, not needed.
systty.h defines it when HAVE_TERMIOS is defined.
2010-08-20 Eli Zaretskii <eliz@gnu.org>
* dispnew.c (buffer_posn_from_coords): Fix last change for text
terminals: add one-character offset for R2L lines.
* emacs.c <emacs_version>: Add a comment regarding
msdos/mainmake.v2's dependency on the syntax of this declaration.
2010-08-20 Eli Zaretskii <eliz@gnu.org>
* dispnew.c (buffer_posn_from_coords): Fix calculation of buffer
position for R2L lines by mirroring the pixel position wrt the
text are box. Improve commentary.
2010-08-20 Andreas Schwab <schwab@linux-m68k.org>
* image.c (imagemagick_clear_image): Remove debugging output.
2010-08-19 Stefan Monnier <monnier@iro.umontreal.ca>
* cmds.c (Vself_insert_face, Vself_insert_face_command): Remove.
(Qpost_self_insert_hook, Vpost_self_insert_hook): New vars.
(internal_self_insert): Run Qpost_self_insert_hook rather than handle
self-insert-face.
(syms_of_cmds): Initialize the new vars.
2010-08-19 Jason Rumney <jasonr@gnu.org>
* w32menu.c (set_frame_menubar): Remove call to undefined function.
* w32fns.c (w32_wnd_proc): Don't check context before initializing.
2010-08-19 Jan Djärv <jan.h.d@swipnet.se>
* nsselect.m (nxatoms_of_nsselect): Use "Selection" and "Secondary".
@ -33,6 +216,17 @@
NXSecondaryPboard = SecondarySelection.
(syms_of_nsselect): Intern QCLIPBOARD (Bug#6677).
2010-08-18 Joakim Verona <joakim@verona.se>
* image.c: Add support for ImageMagick. When HAVE_IMAGEMAGICK is
defined:
(imagemagick_image_p): New function to test for ImageMagic image.
(imagemagick_load): New function to load ImageMagick image.
(imagemagick_load_image): New function, helper for imagemagick_load.
(imagemagick-types): New function.
(Qimagemagick): New Lisp_object.
(imagemagick-render-type): New variable, decides which renderer to use.
2010-08-17 Stefan Monnier <monnier@iro.umontreal.ca>
* gtkutil.c (update_frame_tool_bar): Don't assume TOOL_BAR_ITEM_LABEL
@ -329,10 +523,10 @@
2010-08-08 Kenichi Handa <handa@m17n.org>
* charset.c: Include <stdlib.h>
* charset.c: Include <stdlib.h>.
(struct charset_sort_data): New struct.
(charset_compare): New function.
(Fsort_charsets): New funciton.
(Fsort_charsets): New function.
(syms_of_charset): Declare Fsort_charsets as a Lisp function.
* coding.c (decode_coding_iso_2022): Fix checking of dimension

9
src/Makefile.in
View File

@ -1,3 +1,4 @@
# Makefile for GNU Emacs.
# Copyright (C) 1985, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
@ -222,6 +223,10 @@ CFLAGS_SOUND= @CFLAGS_SOUND@
RSVG_LIBS= @RSVG_LIBS@
RSVG_CFLAGS= @RSVG_CFLAGS@
IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@
IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
## widget.o if USE_X_TOOLKIT, otherwise empty.
WIDGET_OBJ=@WIDGET_OBJ@
@ -315,7 +320,7 @@ MKDEPDIR=@MKDEPDIR@
## FIXME? MYCPPFLAGS only referenced in etc/DEBUG.
ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} \
${C_SWITCH_MACHINE} ${C_SWITCH_SYSTEM} ${C_SWITCH_X_SITE} \
${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} \
${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} \
${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \
${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \
${C_WARNINGS_SWITCH} ${CFLAGS}
@ -590,7 +595,7 @@ SOME_MACHINE_LISP = ../lisp/mouse.elc \
## duplicated symbols. If the standard libraries were compiled
## with GCC, we might need LIB_GCC again after them.
LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \
$(RSVG_LIBS) $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
$(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)

15
src/alloc.c
View File

@ -214,16 +214,6 @@ int abort_on_gc;
int garbage_collection_messages;
#ifndef VIRT_ADDR_VARIES
extern
#endif /* VIRT_ADDR_VARIES */
int malloc_sbrk_used;
#ifndef VIRT_ADDR_VARIES
extern
#endif /* VIRT_ADDR_VARIES */
int malloc_sbrk_unused;
/* Number of live and free conses etc. */
static int total_conses, total_markers, total_symbols, total_vector_size;
@ -6178,11 +6168,6 @@ init_alloc_once (void)
consing_since_gc = 0;
gc_cons_threshold = 100000 * sizeof (Lisp_Object);
gc_relative_threshold = 0;
#ifdef VIRT_ADDR_VARIES
malloc_sbrk_unused = 1<<22; /* A large number */
malloc_sbrk_used = 100000; /* as reasonable as any number */
#endif /* VIRT_ADDR_VARIES */
}
void

5
src/callproc.c
View File

@ -1231,8 +1231,6 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
#else
setpgrp (pid, pid);
#endif /* USG */
/* setpgrp_of_tty is incorrect here; it uses input_fd. */
EMACS_SET_TTY_PGRP (0, &pid);
#ifdef MSDOS
pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
@ -1251,6 +1249,9 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L
report_file_error ("Spawning child process", Qnil);
return cpid;
#else /* not WINDOWSNT */
/* setpgrp_of_tty is incorrect here; it uses input_fd. */
EMACS_SET_TTY_PGRP (0, &pid);
/* execvp does not accept an environment arg so the only way
to pass this environment is to set environ. Our caller
is responsible for restoring the ambient value of environ. */

41
src/cmds.c
View File

@ -37,12 +37,6 @@ Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
/* A possible value for a buffer's overwrite-mode variable. */
Lisp_Object Qoverwrite_mode_binary;
/* Non-nil means put this face on the next self-inserting character. */
Lisp_Object Vself_insert_face;
/* This is the command that set up Vself_insert_face. */
Lisp_Object Vself_insert_face_command;
static int internal_self_insert (int, int);
DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
@ -346,6 +340,7 @@ After insertion, the value of `auto-fill-function' is called if the
A value of 2 means this did things that call for an undo boundary. */
static Lisp_Object Qexpand_abbrev;
static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook;
static int
internal_self_insert (int c, int noautofill)
@ -451,10 +446,10 @@ internal_self_insert (int c, int noautofill)
&& synt != Sword
&& NILP (current_buffer->read_only)
&& PT > BEGV
&& (!NILP (current_buffer->enable_multibyte_characters)
? SYNTAX (XFASTINT (Fprevious_char ())) == Sword
: (SYNTAX (UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
== Sword)))
&& (SYNTAX (!NILP (current_buffer->enable_multibyte_characters)
? XFASTINT (Fprevious_char ())
: UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
== Sword))
{
int modiff = MODIFF;
Lisp_Object sym;
@ -514,15 +509,6 @@ internal_self_insert (int c, int noautofill)
hairy = 2;
}
/* If previous command specified a face to use, use it. */
if (!NILP (Vself_insert_face)
&& EQ (current_kboard->Vlast_command, Vself_insert_face_command))
{
Fput_text_property (make_number (PT - 1), make_number (PT),
Qface, Vself_insert_face, Qnil);
Vself_insert_face = Qnil;
}
if ((synt == Sclose || synt == Smath)
&& !NILP (Vblink_paren_function) && INTERACTIVE
&& !noautofill)
@ -530,6 +516,9 @@ internal_self_insert (int c, int noautofill)
call0 (Vblink_paren_function);
hairy = 2;
}
/* Run hooks for electric keys. */
call1 (Vrun_hooks, Qpost_self_insert_hook);
return hairy;
}
@ -550,15 +539,13 @@ syms_of_cmds (void)
Qexpand_abbrev = intern_c_string ("expand-abbrev");
staticpro (&Qexpand_abbrev);
DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
doc: /* If non-nil, set the face of the next self-inserting character to this.
See also `self-insert-face-command'. */);
Vself_insert_face = Qnil;
Qpost_self_insert_hook = intern_c_string ("post-self-insert-hook");
staticpro (&Qpost_self_insert_hook);
DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command,
doc: /* This is the command that set up `self-insert-face'.
If `last-command' does not equal this value, we ignore `self-insert-face'. */);
Vself_insert_face_command = Qnil;
DEFVAR_LISP ("post-self-insert-hook", &Vpost_self_insert_hook,
doc: /* Hook run at the end of `self-insert-command'.
This run is run after inserting the charater. */);
Vpost_self_insert_hook = Qnil;
DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
doc: /* Function called, if non-nil, whenever a close parenthesis is inserted.

50
src/composite.c
View File

@ -969,7 +969,9 @@ autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT
static Lisp_Object _work_val;
static int _work_char;
/* 1 iff the character C is composable. */
/* 1 iff the character C is composable. Characters of general
category Z? or C? are not composable except for ZWNJ and ZWJ. */
#define CHAR_COMPOSABLE_P(C) \
((C) == 0x200C || (C) == 0x200D \
|| (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
@ -1028,19 +1030,6 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
cmp_it->stop_pos = endpos = start;
cmp_it->ch = -1;
}
if (NILP (string))
{
/* A composition never strides over PT. */
if (PT > charpos)
{
if (PT < endpos)
cmp_it->stop_pos = endpos = PT;
}
else if (PT < charpos && PT > endpos)
{
cmp_it->stop_pos = endpos = PT - 1;
}
}
if (NILP (current_buffer->enable_multibyte_characters)
|| NILP (Vauto_composition_mode))
return;
@ -1091,6 +1080,16 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
}
}
}
if (charpos == endpos)
{
/* We couldn't find a composition point before ENDPOS. But,
some character after ENDPOS may be composed with
characters before ENDPOS. So, we should stop at the safe
point. */
charpos = endpos - MAX_AUTO_COMPOSITION_LOOKBACK;
if (charpos < start)
charpos = start;
}
}
else if (charpos > endpos)
{
@ -1223,23 +1222,8 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
int
composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, struct window *w, struct face *face, Lisp_Object string)
{
if (endpos <= charpos)
{
if (NILP (string))
{
if (endpos < 0)
endpos = BEGV;
if (endpos < PT && PT < charpos)
endpos = PT;
}
else if (endpos < 0)
endpos = 0;
}
else
{
if (NILP (string) && charpos < PT && PT < endpos)
endpos = PT;
}
if (endpos < 0)
endpos = NILP (string) ? BEGV : 0;
if (cmp_it->ch == -2)
{
@ -1301,7 +1285,7 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I
elt = XCAR (val);
if (cmp_it->lookback > 0)
{
cpos -= cmp_it->lookback;
cpos = charpos - cmp_it->lookback;
if (STRINGP (string))
bpos = string_char_to_byte (string, cpos);
else
@ -1763,8 +1747,6 @@ should be ignored. */)
CHECK_NATNUM (from);
CHECK_NATNUM (to);
if (XINT (to) > XINT (from) + MAX_COMPOSITION_COMPONENTS)
to = make_number (XINT (from) + MAX_COMPOSITION_COMPONENTS);
if (! FONT_OBJECT_P (font_object))
{
struct coding_system *coding;

6
src/config.in
View File

@ -294,6 +294,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if netdb.h declares h_errno. */
#undef HAVE_H_ERRNO
/* Define to 1 if using imagemagick. */
#undef HAVE_IMAGEMAGICK
/* Define to 1 if you have inet sockets. */
#undef HAVE_INET_SOCKETS
@ -432,6 +435,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Define to 1 if you have the <mach/mach.h> header file. */
#undef HAVE_MACH_MACH_H
/* Define to 1 if you have the `MagickExportImagePixels' function. */
#undef HAVE_MAGICKEXPORTIMAGEPIXELS
/* Define to 1 if you have the <maillock.h> header file. */
#undef HAVE_MAILLOCK_H

234
src/dbusbind.c
View File

@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Subroutines. */
Lisp_Object Qdbus_init_bus;
Lisp_Object Qdbus_close_bus;
Lisp_Object Qdbus_get_unique_name;
Lisp_Object Qdbus_call_method;
Lisp_Object Qdbus_call_method_asynchronously;
@ -59,6 +60,9 @@ Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
Lisp_Object QCdbus_type_array, QCdbus_type_variant;
Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
/* Registered buses. */
Lisp_Object Vdbus_registered_buses;
/* Hash table which keeps function definitions. */
Lisp_Object Vdbus_registered_objects_table;
@ -111,7 +115,7 @@ int xd_in_read_queued_messages = 0;
} while (0)
/* Macros for debugging. In order to enable them, build with
"make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
"MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
#ifdef DBUS_DEBUG
#define XD_DEBUG_MESSAGE(...) \
do { \
@ -713,10 +717,10 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
}
}
/* Initialize D-Bus connection. BUS is a Lisp symbol, either :system
or :session. It tells which D-Bus to initialize. If RAISE_ERROR
is non-zero signal an error when the connection cannot be
initialized. */
/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
or :session, or a string denoting the bus address. It tells which
D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
when the connection cannot be initialized. */
static DBusConnection *
xd_initialize (Lisp_Object bus, int raise_error)
{
@ -724,34 +728,66 @@ xd_initialize (Lisp_Object bus, int raise_error)
DBusError derror;
/* Parameter check. */
CHECK_SYMBOL (bus);
if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
if (raise_error)
XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
else
return NULL;
if (!STRINGP (bus))
{
CHECK_SYMBOL (bus);
if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
{
if (raise_error)
XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
else
return NULL;
}
/* We do not want to have an autolaunch for the session bus. */
if (EQ (bus, QCdbus_session_bus)
&& getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
if (raise_error)
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
return NULL;
/* We do not want to have an autolaunch for the session bus. */
if (EQ (bus, QCdbus_session_bus)
&& getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
{
if (raise_error)
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
return NULL;
}
}
/* Open a connection to the bus. */
dbus_error_init (&derror);
if (EQ (bus, QCdbus_system_bus))
connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
if (STRINGP (bus))
connection = dbus_connection_open (SDATA (bus), &derror);
else
connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
if (EQ (bus, QCdbus_system_bus))
connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
else
connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
if (dbus_error_is_set (&derror))
if (raise_error)
XD_ERROR (derror);
else
connection = NULL;
{
if (raise_error)
XD_ERROR (derror);
else
connection = NULL;
}
/* If it is not the system or session bus, we must register
ourselves. Otherwise, we have called dbus_bus_get, which has
configured us to exit if the connection closes - we undo this
setting. */
if (connection != NULL)
{
if (STRINGP (bus))
dbus_bus_register (connection, &derror);
else
dbus_connection_set_exit_on_disconnect (connection, FALSE);
}
if (dbus_error_is_set (&derror))
{
if (raise_error)
XD_ERROR (derror);
else
connection = NULL;
}
if (connection == NULL && raise_error)
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
@ -794,7 +830,8 @@ xd_add_watch (DBusWatch *watch, void *data)
}
/* Remove connection file descriptor from input_wait_mask. DATA is
the used bus, either QCdbus_system_bus or QCdbus_session_bus. */
the used bus, either a string or QCdbus_system_bus or
QCdbus_session_bus. */
void
xd_remove_watch (DBusWatch *watch, void *data)
{
@ -830,15 +867,11 @@ xd_remove_watch (DBusWatch *watch, void *data)
}
DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
doc: /* Initialize connection to D-Bus BUS.
This is an internal function, it shall not be used outside dbus.el. */)
doc: /* Initialize connection to D-Bus BUS. */)
(Lisp_Object bus)
{
DBusConnection *connection;
/* Check parameters. */
CHECK_SYMBOL (bus);
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
@ -850,6 +883,28 @@ This is an internal function, it shall not be used outside dbus.el. */)
NULL, (void*) XHASH (bus), NULL))
XD_SIGNAL1 (build_string ("Cannot add watch functions"));
/* Add bus to list of registered buses. */
Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses);
/* Return. */
return Qnil;
}
DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
doc: /* Close connection to D-Bus BUS. */)
(Lisp_Object bus)
{
DBusConnection *connection;
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
/* Decrement reference count to the bus. */
dbus_connection_unref (connection);
/* Remove bus from list of registered buses. */
Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
/* Return. */
return Qnil;
}
@ -862,9 +917,6 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
DBusConnection *connection;
const char *name;
/* Check parameters. */
CHECK_SYMBOL (bus);
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
@ -880,7 +932,8 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
doc: /* Call METHOD on the D-Bus BUS.
BUS is either the symbol `:system' or the symbol `:session'.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@ -967,7 +1020,6 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI
interface = args[3];
method = args[4];
CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@ -1082,7 +1134,8 @@ DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
Sdbus_call_method_asynchronously, 6, MANY, 0,
doc: /* Call METHOD on the D-Bus BUS asynchronously.
BUS is either the symbol `:system' or the symbol `:session'.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@ -1148,7 +1201,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE
method = args[4];
handler = args[5];
CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@ -1271,7 +1323,6 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
serial = args[1];
service = args[2];
CHECK_SYMBOL (bus);
CHECK_NUMBER (serial);
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
@ -1363,7 +1414,6 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
serial = args[1];
service = args[2];
CHECK_SYMBOL (bus);
CHECK_NUMBER (serial);
CHECK_STRING (service);
GCPRO3 (bus, serial, service);
@ -1436,7 +1486,8 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
doc: /* Send signal SIGNAL on the D-Bus BUS.
BUS is either the symbol `:system' or the symbol `:session'.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
D-Bus object path SERVICE is registered at. INTERFACE is an interface
@ -1480,7 +1531,6 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
interface = args[3];
signal = args[4];
CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@ -1552,7 +1602,8 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
}
/* Check, whether there is pending input in the message queue of the
D-Bus BUS. BUS is a Lisp symbol, either :system or :session. */
D-Bus BUS. BUS is either a Lisp symbol, :system or :session, or a
string denoting the bus address. */
int
xd_get_dispatch_status (Lisp_Object bus)
{
@ -1572,24 +1623,31 @@ xd_get_dispatch_status (Lisp_Object bus)
? TRUE : FALSE;
}
/* Check for queued incoming messages from the system and session buses. */
/* Check for queued incoming messages from the buses. */
int
xd_pending_messages (void)
{
Lisp_Object busp = Vdbus_registered_buses;
/* Vdbus_registered_objects_table will be initialized as hash table
in dbus.el. When this package isn't loaded yet, it doesn't make
sense to handle D-Bus messages. */
return (HASH_TABLE_P (Vdbus_registered_objects_table)
? (xd_get_dispatch_status (QCdbus_system_bus)
|| ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL)
? xd_get_dispatch_status (QCdbus_session_bus)
: FALSE))
: FALSE);
while (!NILP (busp))
{
/* We do not want to have an autolaunch for the session bus. */
if (EQ ((CAR_SAFE (busp)), QCdbus_session_bus)
&& getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
continue;
if (xd_get_dispatch_status (CAR_SAFE (busp)))
return TRUE;
busp = CDR_SAFE (busp);
}
return FALSE;
}
/* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
symbol, either :system or :session. */
/* Read queued incoming message of the D-Bus BUS. BUS is either a
Lisp symbol, :system or :session, or a string denoting the bus
address. */
static Lisp_Object
xd_read_message (Lisp_Object bus)
{
@ -1746,29 +1804,28 @@ xd_read_message (Lisp_Object bus)
RETURN_UNGCPRO (Qnil);
}
/* Read queued incoming messages from the system and session buses. */
/* Read queued incoming messages from all buses. */
void
xd_read_queued_messages (void)
{
Lisp_Object busp = Vdbus_registered_buses;
/* Vdbus_registered_objects_table will be initialized as hash table
in dbus.el. When this package isn't loaded yet, it doesn't make
sense to handle D-Bus messages. Furthermore, we ignore all Lisp
errors during the call. */
if (HASH_TABLE_P (Vdbus_registered_objects_table))
xd_in_read_queued_messages = 1;
while (!NILP (busp))
{
xd_in_read_queued_messages = 1;
internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus);
internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus);
xd_in_read_queued_messages = 0;
/* We ignore all Lisp errors during the call. */
internal_catch (Qdbus_error, xd_read_message, CAR_SAFE (busp));
busp = CDR_SAFE (busp);
}
xd_in_read_queued_messages = 0;
}
DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
6, MANY, 0,
doc: /* Register for signal SIGNAL on the D-Bus BUS.
BUS is either the symbol `:system' or the symbol `:session'.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name used by the sending D-Bus object.
It can be either a known name or the unique name of the D-Bus object
@ -1822,7 +1879,6 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG
signal = args[4];
handler = args[5];
CHECK_SYMBOL (bus);
if (!NILP (service)) CHECK_STRING (service);
if (!NILP (path)) CHECK_STRING (path);
CHECK_STRING (interface);
@ -1915,7 +1971,8 @@ DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
6, 6, 0,
doc: /* Register for method METHOD on the D-Bus BUS.
BUS is either the symbol `:system' or the symbol `:session'.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus object METHOD is
registered for. It must be a known name.
@ -1933,7 +1990,6 @@ used for composing the returning D-Bus message. */)
DBusError derror;
/* Check parameters. */
CHECK_SYMBOL (bus);
CHECK_STRING (service);
CHECK_STRING (path);
CHECK_STRING (interface);
@ -1978,6 +2034,10 @@ syms_of_dbusbind (void)
staticpro (&Qdbus_init_bus);
defsubr (&Sdbus_init_bus);
Qdbus_close_bus = intern_c_string ("dbus-close-bus");
staticpro (&Qdbus_close_bus);
defsubr (&Sdbus_close_bus);
Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name");
staticpro (&Qdbus_get_unique_name);
defsubr (&Sdbus_get_unique_name);
@ -2074,18 +2134,25 @@ syms_of_dbusbind (void)
QCdbus_type_dict_entry = intern_c_string (":dict-entry");
staticpro (&QCdbus_type_dict_entry);
DEFVAR_LISP ("dbus-registered-buses",
&Vdbus_registered_buses,
doc: /* List of D-Bus buses we are polling for messages. */);
Vdbus_registered_buses = Qnil;
DEFVAR_LISP ("dbus-registered-objects-table",
&Vdbus_registered_objects_table,
doc: /* Hash table of registered functions for D-Bus.
There are two different uses of the hash table: for accessing
registered interfaces properties, targeted by signals or method calls,
and for calling handlers in case of non-blocking method call returns.
In the first case, the key in the hash table is the list (BUS
INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol
`:session'. INTERFACE is a string which denotes a D-Bus interface,
and MEMBER, also a string, is either a method, a signal or a property
INTERFACE is offering. All arguments but BUS must not be nil.
INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
`:session', or a string denoting the bus address. INTERFACE is a
string which denotes a D-Bus interface, and MEMBER, also a string, is
either a method, a signal or a property INTERFACE is offering. All
arguments but BUS must not be nil.
The value in the hash table is a list of quadruple lists
\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
@ -2097,15 +2164,18 @@ be called when a D-Bus message, which matches the key criteria,
arrives (methods and signals), or a cons cell containing the value of
the property.
In the second case, the key in the hash table is the list (BUS SERIAL).
BUS is either the symbol `:system' or the symbol `:session'. SERIAL
is the serial number of the non-blocking method call, a reply is
expected. Both arguments must not be nil. The value in the hash
table is HANDLER, the function to be called when the D-Bus reply
message arrives. */);
/* We initialize Vdbus_registered_objects_table in dbus.el, because
we need to define a hash table function first. */
Vdbus_registered_objects_table = Qnil;
In the second case, the key in the hash table is the list (BUS
SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
string denoting the bus address. SERIAL is the serial number of the
non-blocking method call, a reply is expected. Both arguments must
not be nil. The value in the hash table is HANDLER, the function to
be called when the D-Bus reply message arrives. */);
{
Lisp_Object args[2];
args[0] = QCtest;
args[1] = Qequal;
Vdbus_registered_objects_table = Fmake_hash_table (2, args);
}
DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);

4
src/deps.mk
View File

@ -142,7 +142,7 @@ mktime.o: mktime.c $(config_h)
msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h frame.h \
termopts.h termchar.h character.h coding.h ccl.h disptab.h window.h \
keyboard.h $(INTERVALS_H) buffer.h commands.h blockinput.h atimer.h \
lisp.h $(config_h)
lisp.h sysselect.h $(config_h)
nsfns.o: nsfns.m charset.h nsterm.h nsgui.h frame.h window.h buffer.h \
dispextern.h fontset.h $(INTERVALS_H) keyboard.h blockinput.h \
atimer.h systime.h epaths.h termhooks.h coding.h systime.h lisp.h $(config_h)
@ -176,7 +176,7 @@ syntax.o: syntax.c syntax.h buffer.h commands.h category.h character.h \
sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \
process.h dispextern.h termhooks.h termchar.h termopts.h coding.h \
frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h lisp.h \
$(config_h) composite.h
$(config_h) composite.h sysselect.h
term.o: term.c termchar.h termhooks.h termopts.h lisp.h $(config_h) \
cm.h frame.h disptab.h keyboard.h character.h charset.h coding.h ccl.h \
xterm.h msdos.h window.h keymap.h blockinput.h atimer.h systime.h \

41
src/dispnew.c
View File

@ -5351,9 +5351,15 @@ update_frame_line (struct frame *f, int vpos)
***********************************************************************/
/* Determine what's under window-relative pixel position (*X, *Y).
Return the object (string or buffer) that's there.
Return the OBJECT (string or buffer) that's there.
Return in *POS the position in that object.
Adjust *X and *Y to character positions. */
Adjust *X and *Y to character positions.
Return in *DX and *DY the pixel coordinates of the click,
relative to the top left corner of OBJECT, or relative to
the top left corner of the character glyph at (*X, *Y)
if OBJECT is nil.
Return WIDTH and HEIGHT of the object at (*X, *Y), or zero
if the coordinates point to an empty area of the display. */
Lisp_Object
buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *pos, Lisp_Object *object, int *dx, int *dy, int *width, int *height)
@ -5366,7 +5372,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
#ifdef HAVE_WINDOW_SYSTEM
struct image *img = 0;
#endif
int x0, x1;
int x0, x1, to_x;
/* We used to set current_buffer directly here, but that does the
wrong thing with `face-remapping-alist' (bug#2044). */
@ -5377,8 +5383,33 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
start_display (&it, w, startp);
x0 = *x - WINDOW_LEFT_MARGIN_WIDTH (w);
move_it_to (&it, -1, x0 + it.first_visible_x, *y, -1,
MOVE_TO_X | MOVE_TO_Y);
/* First, move to the beginning of the row corresponding to *Y. We
need to be in that row to get the correct value of base paragraph
direction for the text at (*X, *Y). */
move_it_to (&it, -1, 0, *y, -1, MOVE_TO_X | MOVE_TO_Y);
/* TO_X is the pixel position that the iterator will compute for the
glyph at *X. We add it.first_visible_x because iterator
positions include the hscroll. */
to_x = x0 + it.first_visible_x;
if (it.bidi_it.paragraph_dir == R2L)
/* For lines in an R2L paragraph, we need to mirror TO_X wrt the
text area. This is because the iterator, even in R2L
paragraphs, delivers glyphs as if they started at the left
margin of the window. (When we actually produce glyphs for
display, we reverse their order in PRODUCE_GLYPHS, but the
iterator doesn't know about that.) The following line adjusts
the pixel position to the iterator geometry, which is what
move_it_* routines use. (The -1 is because in a window whose
text-area width is W, the rightmost pixel position is W-1, and
it should be mirrored into zero pixel position.) */
to_x = window_box_width (w, TEXT_AREA) - to_x - 1;
/* Now move horizontally in the row to the glyph under *X. Second
argument is ZV to prevent move_it_in_display_line from matching
based on buffer positions. */
move_it_in_display_line (&it, ZV, to_x, MOVE_TO_X);
Fset_buffer (old_current_buffer);

29
src/doc.c
View File

@ -285,8 +285,7 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
to - (get_doc_string_buffer + offset));
else
{
/* Let the data determine whether the string is multibyte,
even if Emacs is running in --unibyte mode. */
/* The data determines whether the string is multibyte. */
int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
@ -622,24 +621,28 @@ the same file name is found in the `doc-directory'. */)
p = buf;
end = buf + (filled < 512 ? filled : filled - 128);
while (p != end && *p != '\037') p++;
/* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
/* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
if (p != end)
{
end = strchr (p, '\n');
/* See if this is a file name, and if it is a file in build-files. */
if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
&& (end[-1] == 'o' || end[-1] == 'c'))
if (p[1] == 'S')
{
int len = end - p - 2;
char *fromfile = alloca (len + 1);
strncpy (fromfile, &p[2], len);
fromfile[len] = 0;
if (fromfile[len-1] == 'c')
fromfile[len-1] = 'o';
skip_file = 0;
if (end - p > 4 && end[-2] == '.'
&& (end[-1] == 'o' || end[-1] == 'c'))
{
int len = end - p - 2;
char *fromfile = alloca (len + 1);
strncpy (fromfile, &p[2], len);
fromfile[len] = 0;
if (fromfile[len-1] == 'c')
fromfile[len-1] = 'o';
skip_file = NILP (Fmember (build_string (fromfile),
Vbuild_files));
skip_file = NILP (Fmember (build_string (fromfile),
Vbuild_files));
}
}
sym = oblookup (Vobarray, p + 2,

70
src/emacs.c
View File

@ -91,6 +91,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#endif
/* If you change the following line, remember to update
msdos/mainmake.v2 which gleans the Emacs version from it! */
static const char emacs_copyright[] = "Copyright (C) 2010 Free Software Foundation, Inc.";
static const char emacs_version[] = "24.0.50";
@ -1330,68 +1332,6 @@ main (int argc, char **argv)
init_atimer ();
running_asynch_code = 0;
/* Handle --unibyte and the EMACS_UNIBYTE envvar,
but not while dumping. */
if (1)
{
int inhibit_unibyte = 0;
/* --multibyte overrides EMACS_UNIBYTE. */
if (argmatch (argv, argc, "-no-unibyte", "--no-unibyte", 4, NULL, &skip_args)
|| argmatch (argv, argc, "-multibyte", "--multibyte", 4, NULL, &skip_args)
/* Ignore EMACS_UNIBYTE before dumping. */
|| (!initialized && noninteractive))
inhibit_unibyte = 1;
/* --unibyte requests that we set up to do everything with single-byte
buffers and strings. We need to handle this before calling
init_lread, init_editfns and other places that generate Lisp strings
from text in the environment. */
/* Actually this shouldn't be needed as of 20.4 in a generally
unibyte environment. As handa says, environment values
aren't now decoded; also existing buffers are now made
unibyte during startup if .emacs sets unibyte. Tested with
8-bit data in environment variables and /etc/passwd, setting
unibyte and Latin-1 in .emacs. -- Dave Love */
if (argmatch (argv, argc, "-unibyte", "--unibyte", 4, NULL, &skip_args)
|| argmatch (argv, argc, "-no-multibyte", "--no-multibyte", 4, NULL, &skip_args)
|| (getenv ("EMACS_UNIBYTE") && !inhibit_unibyte))
{
Lisp_Object old_log_max;
Lisp_Object symbol, tail;
symbol = intern_c_string ("enable-multibyte-characters");
Fset_default (symbol, Qnil);
if (initialized)
{
/* Erase pre-dump messages in *Messages* now so no abort. */
old_log_max = Vmessage_log_max;
XSETFASTINT (Vmessage_log_max, 0);
message_dolog ("", 0, 1, 0);
Vmessage_log_max = old_log_max;
}
for (tail = Vbuffer_alist; CONSP (tail);
tail = XCDR (tail))
{
Lisp_Object buffer;
buffer = Fcdr (XCAR (tail));
/* Make a multibyte buffer unibyte. */
if (BUF_Z_BYTE (XBUFFER (buffer)) > BUF_Z (XBUFFER (buffer)))
{
struct buffer *current = current_buffer;
set_buffer_temp (XBUFFER (buffer));
Fset_buffer_multibyte (Qnil);
set_buffer_temp (current);
}
}
message ("Warning: unibyte sessions are obsolete and will disappear");
}
}
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
@ -1790,10 +1730,6 @@ const struct standard_args standard_args[] =
{ "-script", "--script", 100, 1 },
{ "-daemon", "--daemon", 99, 0 },
{ "-help", "--help", 90, 0 },
{ "-no-unibyte", "--no-unibyte", 83, 0 },
{ "-multibyte", "--multibyte", 82, 0 },
{ "-unibyte", "--unibyte", 81, 0 },
{ "-no-multibyte", "--no-multibyte", 80, 0 },
{ "-nl", "--no-loadup", 70, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
@ -2094,7 +2030,7 @@ shut_down_emacs (int sig, int no_x, Lisp_Object stuff)
Vinhibit_redisplay = Qt;
/* If we are controlling the terminal, reset terminal modes. */
#ifdef EMACS_HAVE_TTY_PGRP
#ifndef DOS_NT
{
int pgrp = EMACS_GETPGRP (0);

27
src/eval.c
View File

@ -1011,12 +1011,13 @@ usage: (let VARLIST BODY...) */)
int count = SPECPDL_INDEX ();
register int argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
varlist = Fcar (args);
/* Make space to hold the values to give the bound variables */
elt = Flength (varlist);
temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object));
SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
/* Compute the values and store them in `temps' */
@ -1049,6 +1050,7 @@ usage: (let VARLIST BODY...) */)
}
elt = Fprogn (Fcdr (args));
SAFE_FREE ();
return unbind_to (count, elt);
}
@ -2301,8 +2303,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
/* Pass a vector of evaluated arguments */
Lisp_Object *vals;
register int argnum = 0;
USE_SAFE_ALLOCA;
vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
SAFE_ALLOCA_LISP (vals, XINT (numargs));
GCPRO3 (args_left, fun, fun);
gcpro3.var = vals;
@ -2320,6 +2323,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
UNGCPRO;
SAFE_FREE ();
goto done;
}
@ -2430,8 +2434,9 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
register int i, numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun;
Lisp_Object fun, retval;
struct gcpro gcpro1;
USE_SAFE_ALLOCA;
fun = args [0];
funcall_args = 0;
@ -2470,8 +2475,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
{
/* Avoid making funcall cons up a yet another new vector of arguments
by explicitly supplying nil's for optional values */
funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args)
* sizeof (Lisp_Object));
SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
for (i = numargs; i < XSUBR (fun)->max_args;)
funcall_args[++i] = Qnil;
GCPRO1 (*funcall_args);
@ -2483,8 +2487,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
function itself as well as its arguments. */
if (!funcall_args)
{
funcall_args = (Lisp_Object *) alloca ((1 + numargs)
* sizeof (Lisp_Object));
SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
GCPRO1 (*funcall_args);
gcpro1.nvars = 1 + numargs;
}
@ -2500,7 +2503,11 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
}
/* By convention, the caller needs to gcpro Ffuncall's args. */
RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
retval = Ffuncall (gcpro1.nvars, funcall_args);
UNGCPRO;
SAFE_FREE ();
return retval;
}
/* Run hook variables in various ways. */
@ -3065,9 +3072,10 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
struct gcpro gcpro1, gcpro2, gcpro3;
register int i;
register Lisp_Object tem;
USE_SAFE_ALLOCA;
numargs = Flength (args);
arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
SAFE_ALLOCA_LISP (arg_vector, XINT (numargs));
args_left = args;
GCPRO3 (*arg_vector, args_left, fun);
@ -3096,6 +3104,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
/* Don't do it again when we return to eval. */
backtrace_list->debug_on_exit = 0;
SAFE_FREE ();
return tem;
}

535
src/image.c
View File

@ -583,7 +583,7 @@ Lisp_Object Qxbm;
Lisp_Object QCascent, QCmargin, QCrelief, Qcount, Qextension_data;
Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask, QCgeometry, QCcrop, QCrotation;
/* Other symbols. */
@ -7342,6 +7342,510 @@ gif_load (struct frame *f, struct image *img)
#endif /* HAVE_GIF */
/***********************************************************************
imagemagick
***********************************************************************/
#if defined (HAVE_IMAGEMAGICK)
Lisp_Object Vimagemagick_render_type;
/* The symbol `imagemagick' identifying images of this type. */
Lisp_Object Qimagemagick;
Lisp_Object Vimagemagick_render_type;
/* Indices of image specification fields in imagemagick_format, below. */
enum imagemagick_keyword_index
{
IMAGEMAGICK_TYPE,
IMAGEMAGICK_DATA,
IMAGEMAGICK_FILE,
IMAGEMAGICK_ASCENT,
IMAGEMAGICK_MARGIN,
IMAGEMAGICK_RELIEF,
IMAGEMAGICK_ALGORITHM,
IMAGEMAGICK_HEURISTIC_MASK,
IMAGEMAGICK_MASK,
IMAGEMAGICK_BACKGROUND,
IMAGEMAGICK_HEIGHT,
IMAGEMAGICK_WIDTH,
IMAGEMAGICK_ROTATION,
IMAGEMAGICK_CROP,
IMAGEMAGICK_LAST
};
/* Vector of image_keyword structures describing the format
of valid user-defined image specifications. */
static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] =
{
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
{":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":background", IMAGE_STRING_OR_NIL_VALUE, 0},
{":height", IMAGE_INTEGER_VALUE, 0},
{":width", IMAGE_INTEGER_VALUE, 0},
{":rotation", IMAGE_NUMBER_VALUE, 0},
{":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
/* Free X resources of imagemagick image IMG which is used on frame F. */
static void
imagemagick_clear_image (struct frame *f,
struct image *img)
{
x_clear_image (f, img);
}
/* Return non-zero if OBJECT is a valid IMAGEMAGICK image specification. Do
this by calling parse_image_spec and supplying the keywords that
identify the IMAGEMAGICK format. */
static int
imagemagick_image_p (Lisp_Object object)
{
struct image_keyword fmt[IMAGEMAGICK_LAST];
bcopy (imagemagick_format, fmt, sizeof fmt);
if (!parse_image_spec (object, fmt, IMAGEMAGICK_LAST, Qimagemagick))
return 0;
/* Must specify either the :data or :file keyword. */
return fmt[IMAGEMAGICK_FILE].count + fmt[IMAGEMAGICK_DATA].count == 1;
}
/* The GIF library also defines DrawRectangle, but its never used in Emacs.
Therefore rename the function so it doesnt collide with ImageMagick. */
#define DrawRectangle DrawRectangleGif
#include <wand/MagickWand.h>
/* imagemagick_load_image is a helper function for imagemagick_load,
which does the actual loading given contents and size, apart from
frame and image structures, passed from imagemagick_load.
Uses librimagemagick to do most of the image processing.
non-zero when successful.
*/
static int
imagemagick_load_image (/* Pointer to emacs frame structure. */
struct frame *f,
/* Pointer to emacs image structure. */
struct image *img,
/* String containing the IMAGEMAGICK data to
be parsed. */
unsigned char *contents,
/* Size of data in bytes. */
unsigned int size,
/* Filename, either pass filename or
contents/size. */
unsigned char *filename)
{
size_t width;
size_t height;
MagickBooleanType
status;
XImagePtr ximg;
Lisp_Object specified_bg;
XColor background;
int x;
int y;
MagickWand *image_wand;
MagickWand *ping_wand;
PixelIterator *iterator;
PixelWand **pixels;
MagickPixelPacket pixel;
Lisp_Object image;
Lisp_Object value;
Lisp_Object crop, geometry;
long ino;
int desired_width, desired_height;
double rotation;
int imagemagick_rendermethod;
int pixelwidth;
ImageInfo *image_info;
ExceptionInfo *exception;
Image * im_image;
/* Handle image index for image types who can contain more than one
image. Interface :index is same as for GIF. First we "ping" the
image to see how many sub-images it contains. Pinging is faster
than loading the image to find out things about it. */
image = image_spec_value (img->spec, QCindex, NULL);
ino = INTEGERP (image) ? XFASTINT (image) : 0;
ping_wand=NewMagickWand();
MagickSetResolution(ping_wand, 2, 2);
if (filename != NULL)
{
status = MagickPingImage(ping_wand, filename);
}
else
{
status = MagickPingImageBlob(ping_wand, contents, size);
}
if (ino >= MagickGetNumberImages(ping_wand))
{
image_error ("Invalid image number `%s' in image `%s'",
image, img->spec);
UNGCPRO;
return 0;
}
if (MagickGetNumberImages(ping_wand) > 1)
img->data.lisp_val =
Fcons (Qcount,
Fcons (make_number (MagickGetNumberImages(ping_wand)),
img->data.lisp_val));
DestroyMagickWand (ping_wand);
/* Now, after pinging, we know how many images are inside the
file. If its not a bundle, just one. */
if (filename != NULL)
{
image_info=CloneImageInfo((ImageInfo *) NULL);
(void) strcpy(image_info->filename, filename);
image_info -> number_scenes = 1;
image_info -> scene = ino;
exception=AcquireExceptionInfo();
im_image = ReadImage (image_info, exception);
CatchException(exception);
image_wand = NewMagickWandFromImage(im_image);
}
else
{
image_wand = NewMagickWand();
status = MagickReadImageBlob(image_wand, contents, size);
}
image_error ("im read failed", Qnil, Qnil);
if (status == MagickFalse) goto imagemagick_error;
/* If width and/or height is set in the display spec assume we want
to scale to those values. if either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
value = image_spec_value (img->spec, QCwidth, NULL);
desired_width = (INTEGERP (value) ? XFASTINT (value) : -1);
value = image_spec_value (img->spec, QCheight, NULL);
desired_height = (INTEGERP (value) ? XFASTINT (value) : -1);
height = MagickGetImageHeight (image_wand);
width = MagickGetImageWidth (image_wand);
if(desired_width != -1 && desired_height == -1)
{
/* w known, calculate h. */
desired_height = ( (double)desired_width / width ) * height;
}
if(desired_width == -1 && desired_height != -1)
{
/* h known, calculate w. */
desired_width = ( (double)desired_height / height ) * width;
}
if(desired_width != -1 && desired_height != -1)
{
status = MagickScaleImage(image_wand, desired_width, desired_height);
if (status == MagickFalse) {
image_error ("Imagemagick scale failed", Qnil, Qnil);
goto imagemagick_error;
}
}
/* crop behaves similar to image slicing in Emacs but is more memory
efficient */
crop = image_spec_value (img->spec, QCcrop, NULL);
if(CONSP (crop))
{
/*
after some testing, it seems MagickCropImage is the fastest
crop function in ImageMagick. This crop function seems to do
less copying than the alternatives, but it still reads the
entire image into memory before croping, which is aparently
difficult to avoid when using imagemagick. */
int w,h,x,y;
w=XFASTINT(XCAR(crop));
h=XFASTINT(XCAR(XCDR(crop)));
x=XFASTINT(XCAR(XCDR(XCDR(crop))));
y=XFASTINT(XCAR(XCDR(XCDR(XCDR(crop)))));
MagickCropImage(image_wand, w,h, x,y);
}
/* Furthermore :rotation. we need background color and angle for
rotation. */
/*
TODO background handling for rotation specified_bg =
image_spec_value (img->spec, QCbackground, NULL); if (!STRINGP
(specified_bg). */
value = image_spec_value (img->spec, QCrotation, NULL);
if (FLOATP (value))
{
PixelWand* background = NewPixelWand();
PixelSetColor (background, "#ffffff");/*TODO remove hardcode*/
rotation = extract_float (value);
status = MagickRotateImage (image_wand, background, rotation);
DestroyPixelWand (background);
if (status == MagickFalse)
{
image_error ("Imagemagick image rotate failed", Qnil, Qnil);
goto imagemagick_error;
}
}
/* Finaly we are done manipulating the image, figure out resulting
width, height, and then transfer ownerwship to Emacs. */
height = MagickGetImageHeight (image_wand);
width = MagickGetImageWidth (image_wand);
if (status == MagickFalse)
{
image_error ("Imagemagick image get size failed", Qnil, Qnil);
goto imagemagick_error;
}
if (! check_image_size (f, width, height))
{
image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil);
goto imagemagick_error;
}
/* We can now get a valid pixel buffer from the imagemagick file, if all
went ok. */
init_color_table ();
imagemagick_rendermethod = (INTEGERP (Vimagemagick_render_type)
? XFASTINT (Vimagemagick_render_type) : 0);
if (imagemagick_rendermethod == 0)
{
/* Try to create a x pixmap to hold the imagemagick pixmap. */
if (!x_create_x_image_and_pixmap (f, width, height, 0,
&ximg, &img->pixmap))
{
image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil);
goto imagemagick_error;
}
/* Copy imagegmagick image to x with primitive yet robust pixel
pusher loop. This has been tested a lot with many different
images. */
/* Copy pixels from the imagemagick image structure to the x image map. */
iterator = NewPixelIterator (image_wand);
if ((iterator == (PixelIterator *) NULL))
{
image_error ("Imagemagick pixel iterator creation failed",
Qnil, Qnil);
goto imagemagick_error;
}
for (y = 0; y < (long) MagickGetImageHeight(image_wand); y++)
{
pixels = PixelGetNextIteratorRow (iterator, &width);
if ((pixels == (PixelWand **) NULL))
break;
for (x = 0; x < (long) width; x++)
{
PixelGetMagickColor (pixels[x], &pixel);
XPutPixel (ximg, x, y,
lookup_rgb_color (f,
pixel.red,
pixel.green,
pixel.blue));
}
}
DestroyPixelIterator (iterator);
}
if (imagemagick_rendermethod == 1)
{
/* Magicexportimage is normaly faster than pixelpushing. This
method is also well tested. Some aspects of this method are
ad-hoc and needs to be more researched. */
int imagedepth = 24;/*MagickGetImageDepth(image_wand);*/
char* exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/
/* Try to create a x pixmap to hold the imagemagick pixmap. */
if (!x_create_x_image_and_pixmap (f, width, height, imagedepth,
&ximg, &img->pixmap)){
image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil);
goto imagemagick_error;
}
/* Oddly, the below code doesnt seem to work:*/
/* switch(ximg->bitmap_unit){ */
/* case 8: */
/* pixelwidth=CharPixel; */
/* break; */
/* case 16: */
/* pixelwidth=ShortPixel; */
/* break; */
/* case 32: */
/* pixelwidth=LongPixel; */
/* break; */
/* } */
/*
Here im just guessing the format of the bitmap.
happens to work fine for:
- bw djvu images
on rgb display.
seems about 3 times as fast as pixel pushing(not carefully measured)
*/
pixelwidth = CharPixel;/*??? TODO figure out*/
#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS
MagickExportImagePixels(image_wand,
0, 0,
width, height,
exportdepth,
pixelwidth,
/*&(img->pixmap));*/
ximg->data);
#else
image_error("You dont have MagickExportImagePixels, upgrade ImageMagick!",
Qnil, Qnil);
#endif
}
#ifdef COLOR_TABLE_SUPPORT
/* Remember colors allocated for this image. */
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
#endif /* COLOR_TABLE_SUPPORT */
img->width = width;
img->height = height;
/* Put the image into the pixmap, then free the X image and its
buffer. */
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
/* Final cleanup. image_wand should be the only resource left. */
DestroyMagickWand (image_wand);
return 1;
imagemagick_error:
/* TODO more cleanup. */
image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil);
return 0;
}
/* Load IMAGEMAGICK image IMG for use on frame F. Value is non-zero if
successful. this function will go into the imagemagick_type structure, and
the prototype thus needs to be compatible with that structure. */
static int
imagemagick_load (struct frame *f,
struct image *img)
{
int success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
file_name = image_spec_value (img->spec, QCfile, NULL);
if (STRINGP (file_name))
{
Lisp_Object file;
unsigned char *contents;
int size;
struct gcpro gcpro1;
file = x_find_image_file (file_name);
GCPRO1 (file);
if (!STRINGP (file))
{
image_error ("Cannot find image file `%s'", file_name, Qnil);
UNGCPRO;
return 0;
}
success_p = imagemagick_load_image (f, img, 0, 0, SDATA(file_name));
UNGCPRO;
}
/* Else its not a file, its a lisp object. Load the image from a
lisp object rather than a file. */
else
{
Lisp_Object data;
data = image_spec_value (img->spec, QCdata, NULL);
success_p = imagemagick_load_image (f, img, SDATA (data),
SBYTES (data), NULL);
}
return success_p;
}
/* Structure describing the image type `imagemagick'. Its the same
type of structure defined for all image formats, handled by Emacs
image functions. See struct image_type in dispextern.h. */
static struct image_type imagemagick_type =
{
/* An identifier showing that this is an image structure for the
IMAGEMAGICK format. */
&Qimagemagick,
/* Handle to a function that can be used to identify a IMAGEMAGICK
file. */
imagemagick_image_p,
/* Handle to function used to load a IMAGEMAGICK file. */
imagemagick_load,
/* Handle to function to free resources for IMAGEMAGICK. */
imagemagick_clear_image,
/* An internal field to link to the next image type in a list of
image types, will be filled in when registering the format. */
NULL
};
DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0,
doc: /* Return image file types supported by ImageMagick.
Since ImageMagick recognizes a lot of file-types that clash with Emacs,
such as .c, we want to be able to alter the list at the lisp level. */)
(void)
{
Lisp_Object typelist = Qnil;
size_t numf;
ExceptionInfo ex;
char** imtypes = GetMagickList ("*", &numf, &ex);
int i;
Lisp_Object Qimagemagicktype;
for (i = 0; i < numf; i++)
{
Qimagemagicktype = intern (imtypes[i]);
typelist = Fcons (Qimagemagicktype, typelist);
}
return typelist;
}
#endif /* defined (HAVE_IMAGEMAGICK) */
/***********************************************************************
SVG
@ -8117,6 +8621,15 @@ of `image-library-alist', which see). */)
return CHECK_LIB_AVAILABLE (&svg_type, init_svg_functions, libraries);
#endif
#if defined (HAVE_IMAGEMAGICK)
if (EQ (type, Qimagemagick)){
/* MagickWandGenesis() initalizes the imagemagick library. */
MagickWandGenesis();
return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
libraries);
}
#endif
#ifdef HAVE_GHOSTSCRIPT
if (EQ (type, Qpostscript))
return CHECK_LIB_AVAILABLE (&gs_type, init_gs_functions, libraries);
@ -8202,6 +8715,12 @@ non-numeric, there is no explicit limit on the size of images. */);
staticpro (&QCheuristic_mask);
QCindex = intern_c_string (":index");
staticpro (&QCindex);
QCgeometry = intern (":geometry");
staticpro (&QCgeometry);
QCcrop = intern (":crop");
staticpro (&QCcrop);
QCrotation = intern (":rotation");
staticpro (&QCrotation);
QCmatrix = intern_c_string (":matrix");
staticpro (&QCmatrix);
QCcolor_adjustment = intern_c_string (":color-adjustment");
@ -8262,6 +8781,12 @@ non-numeric, there is no explicit limit on the size of images. */);
ADD_IMAGE_TYPE (Qpng);
#endif
#if defined (HAVE_IMAGEMAGICK)
Qimagemagick = intern ("imagemagick");
staticpro (&Qimagemagick);
ADD_IMAGE_TYPE (Qimagemagick);
#endif
#if defined (HAVE_RSVG)
Qsvg = intern_c_string ("svg");
staticpro (&Qsvg);
@ -8278,6 +8803,9 @@ non-numeric, there is no explicit limit on the size of images. */);
#endif /* HAVE_RSVG */
defsubr (&Sinit_image_library);
#ifdef HAVE_IMAGEMAGICK
defsubr (&Simagemagick_types);
#endif
defsubr (&Sclear_image_cache);
defsubr (&Simage_flush);
defsubr (&Simage_size);
@ -8308,6 +8836,11 @@ The value can also be nil, meaning the cache is never cleared.
The function `clear-image-cache' disregards this variable. */);
Vimage_cache_eviction_delay = make_number (300);
#ifdef HAVE_IMAGEMAGICK
DEFVAR_LISP ("imagemagick-render-type", &Vimagemagick_render_type,
doc: /* Choose between ImageMagick render methods. */);
#endif
}
void

44
src/keyboard.c
View File

@ -368,7 +368,7 @@ Lisp_Object Vselect_active_regions;
Used by the `select-active-regions' feature. */
Lisp_Object Vsaved_region_selection;
Lisp_Object Qx_set_selection, QPRIMARY;
Lisp_Object Qx_set_selection, QPRIMARY, Qhandle_switch_frame;
Lisp_Object Qself_insert_command;
Lisp_Object Qforward_char;
@ -1799,10 +1799,11 @@ command_loop_1 (void)
{
/* Even if not deactivating the mark, set PRIMARY if
`select-active-regions' is non-nil. */
if (EQ (Vselect_active_regions, Qonly)
? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
: (!NILP (Vselect_active_regions)
&& !NILP (Vtransient_mark_mode)))
if ((EQ (Vselect_active_regions, Qonly)
? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
: (!NILP (Vselect_active_regions)
&& !NILP (Vtransient_mark_mode)))
&& !EQ (Vthis_command, Qhandle_switch_frame))
{
int beg = XINT (Fmarker_position (current_buffer->mark));
int end = XINT (make_number (PT));
@ -10345,13 +10346,12 @@ give to the command you invoke, if it asks for an argument. */)
(Lisp_Object prefixarg)
{
Lisp_Object function;
char buf[40];
int saved_last_point_position;
Lisp_Object saved_keys, saved_last_point_position_buffer;
Lisp_Object bindings, value;
struct gcpro gcpro1, gcpro2, gcpro3;
#ifdef HAVE_WINDOW_SYSTEM
/* The call to Fcompleting_read wil start and cancel the hourglass,
/* The call to Fcompleting_read will start and cancel the hourglass,
but if the hourglass was already scheduled, this means that no
hourglass will be shown for the actual M-x command itself.
So we restart it if it is already scheduled. Note that checking
@ -10364,31 +10364,9 @@ give to the command you invoke, if it asks for an argument. */)
XVECTOR (this_command_keys)->contents);
saved_last_point_position_buffer = last_point_position_buffer;
saved_last_point_position = last_point_position;
buf[0] = 0;
GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
if (EQ (prefixarg, Qminus))
strcpy (buf, "- ");
else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
strcpy (buf, "C-u ");
else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
else if (INTEGERP (prefixarg))
sprintf (buf, "%ld ", (long) XINT (prefixarg));
/* This isn't strictly correct if execute-extended-command
is bound to anything else. Perhaps it should use
this_command_keys? */
strcat (buf, "M-x ");
/* Prompt with buf, and then read a string, completing from and
restricting to the set of all defined commands. Don't provide
any initial input. Save the command read on the extended-command
history list. */
function = Fcompleting_read (build_string (buf),
Vobarray, Qcommandp,
Qt, Qnil, Qextended_command_history, Qnil,
Qnil);
function = call0 (intern ("read-extended-command"));
#ifdef HAVE_WINDOW_SYSTEM
if (hstarted) start_hourglass ();
@ -11506,11 +11484,11 @@ init_keyboard (void)
Emacs on SIGINT when there are no termcap frames on the
controlling terminal. */
signal (SIGINT, interrupt_signal);
#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
#ifndef DOS_NT
/* For systems with SysV TERMIO, C-g is set up for both SIGINT and
SIGQUIT and we can't tell which one it will give us. */
signal (SIGQUIT, interrupt_signal);
#endif /* HAVE_TERMIO */
#endif /* not DOS_NT */
}
/* Note SIGIO has been undef'd if FIONREAD is missing. */
#ifdef SIGIO
@ -11725,6 +11703,8 @@ syms_of_keyboard (void)
staticpro (&Qx_set_selection);
QPRIMARY = intern_c_string ("PRIMARY");
staticpro (&QPRIMARY);
Qhandle_switch_frame = intern_c_string ("handle-switch-frame");
staticpro (&Qhandle_switch_frame);
Qinput_method_exit_on_first_char = intern_c_string ("input-method-exit-on-first-char");
staticpro (&Qinput_method_exit_on_first_char);

1
src/makefile.w32-in
View File

@ -1357,6 +1357,7 @@ $(BLD)/sysdep.$(O) : \
$(SRC)/frame.h \
$(SRC)/keyboard.h \
$(SRC)/process.h \
$(SRC)/sysselect.h \
$(SRC)/syssignal.h \
$(SRC)/systime.h \
$(SRC)/systty.h \

89
src/process.c
View File

@ -31,9 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#ifdef STDC_HEADERS
#include <stdlib.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
@ -61,9 +59,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#if defined(HAVE_SYS_IOCTL_H)
#include <sys/ioctl.h>
#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
#include <fcntl.h>
#endif /* HAVE_PTYS and no O_NDELAY */
#if defined(HAVE_NET_IF_H)
#include <net/if.h>
#endif /* HAVE_NET_IF_H */
@ -182,16 +177,9 @@ extern Lisp_Object QCfilter;
extern const char *get_operating_system_release (void);
/* Serial processes require termios or Windows. */
#if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
#define HAVE_SERIAL
#endif
#ifdef HAVE_SERIAL
/* From sysdep.c or w32.c */
extern int serial_open (char *port);
extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact);
#endif
#ifndef HAVE_H_ERRNO
extern int h_errno;
@ -1903,7 +1891,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
setpgrp ();
#endif /* USG */
#endif /* not HAVE_SETSID */
#if defined (HAVE_TERMIOS) && defined (LDISC1)
#if defined (LDISC1)
if (pty_flag && xforkin >= 0)
{
struct termios t;
@ -2569,7 +2557,6 @@ OPTION is not a supported option, return nil instead; otherwise return t. */)
}
#ifdef HAVE_SERIAL
DEFUN ("serial-process-configure",
Fserial_process_configure,
Sserial_process_configure,
@ -2865,7 +2852,6 @@ usage: (make-serial-process &rest ARGS) */)
UNGCPRO;
return proc;
}
#endif /* HAVE_SERIAL */
/* Create a network stream/datagram client/server process. Treated
exactly like a normal process when reading and writing. Primary
@ -5801,9 +5787,6 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
/* If possible, send signals to the entire pgrp
by sending an input character to it. */
/* TERMIOS is the latest and bestest, and seems most likely to
work. If the system has it, use it. */
#ifdef HAVE_TERMIOS
struct termios t;
cc_t *sig_char = NULL;
@ -5835,65 +5818,6 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
}
/* If we can't send the signal with a character,
fall through and send it another way. */
#else /* ! HAVE_TERMIOS */
/* On Berkeley descendants, the following IOCTL's retrieve the
current control characters. */
#if defined (TIOCGLTC) && defined (TIOCGETC)
struct tchars c;
struct ltchars lc;
switch (signo)
{
case SIGINT:
ioctl (p->infd, TIOCGETC, &c);
send_process (proc, &c.t_intrc, 1, Qnil);
return;
case SIGQUIT:
ioctl (p->infd, TIOCGETC, &c);
send_process (proc, &c.t_quitc, 1, Qnil);
return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (p->infd, TIOCGLTC, &lc);
send_process (proc, &lc.t_suspc, 1, Qnil);
return;
#endif /* ! defined (SIGTSTP) */
}
#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
/* On SYSV descendants, the TCGETA ioctl retrieves the current control
characters. */
#ifdef TCGETA
struct termio t;
switch (signo)
{
case SIGINT:
ioctl (p->infd, TCGETA, &t);
send_process (proc, &t.c_cc[VINTR], 1, Qnil);
return;
case SIGQUIT:
ioctl (p->infd, TCGETA, &t);
send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (p->infd, TCGETA, &t);
send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
return;
#endif /* ! defined (SIGTSTP) */
}
#else /* ! defined (TCGETA) */
Your configuration files are messed up.
/* If your system configuration files define SIGNALS_VIA_CHARACTERS,
you'd better be using one of the alternatives above! */
#endif /* ! defined (TCGETA) */
#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
/* In this case, the code above should alway return. */
abort ();
#endif /* ! defined HAVE_TERMIOS */
/* The code above may fall through if it can't
handle the signal. */
@ -6065,10 +5989,9 @@ traffic. */)
#ifdef WINDOWSNT
if (fd_info[ p->infd ].flags & FILE_SERIAL)
PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
#endif
#ifdef HAVE_TERMIOS
#else /* not WINDOWSNT */
tcflush (p->infd, TCIFLUSH);
#endif
#endif /* not WINDOWSNT */
}
p->command = Qnil;
return process;
@ -6282,10 +6205,10 @@ process has been transmitted to the serial port. */)
send_process (proc, "\004", 1, Qnil);
else if (EQ (XPROCESS (proc)->type, Qserial))
{
#ifdef HAVE_TERMIOS
#ifndef WINDOWSNT
if (tcdrain (XPROCESS (proc)->outfd) != 0)
error ("tcdrain() failed: %s", emacs_strerror (errno));
#endif
#endif /* not WINDOWSNT */
/* Do nothing on Windows because writes are blocking. */
}
else
@ -7672,10 +7595,8 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SERIAL
defsubr (&Sserial_process_configure);
defsubr (&Smake_serial_process);
#endif /* HAVE_SERIAL */
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sformat_network_address);

9
src/puresize.h
View File

@ -87,7 +87,6 @@ extern EMACS_INT pure[];
&& (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
#else /* not VIRT_ADDR_VARIES */
#ifdef PNTR_COMPARISON_TYPE
/* When PNTR_COMPARISON_TYPE is not the default (unsigned int). */
extern char my_edata[];
@ -95,14 +94,6 @@ extern char my_edata[];
#define PURE_P(obj) \
((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) my_edata)
#else /* not VIRT_ADDRESS_VARIES, not PNTR_COMPARISON_TYPE */
extern char my_edata[];
#define PURE_P(obj) \
(XPNTR (obj) < (unsigned int) my_edata)
#endif /* PNTR_COMPARISON_TYPE */
#endif /* VIRT_ADDRESS_VARIES */
/* arch-tag: fd9b0a91-a70e-4729-a75a-6bb4ca1ce14f

4
src/s/aix4-2.h
View File

@ -55,10 +55,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Special items needed to make Emacs run on this system. */
/* The following definition seems to be needed in AIX version 3.1.6.8.
It may not have been needed in certain earlier versions. */
#define HAVE_TCATTR
/* AIX doesn't define this. */
#define unix 1

7
src/s/hpux10-20.h
View File

@ -35,9 +35,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
if system supports pty's. 'p' means it is /dev/ptym/ptyp0 */
#define FIRST_PTY_LETTER 'p'
/* Define HAVE_TERMIO if the system provides sysV-style ioctls
for terminal control. */
#define HAVE_TERMIO
#define HAVE_TERMIOS
#define NO_TERMIO
#define ORDINARY_LINK
/* Define HAVE_PTYS if the system supports pty devices. */
#define HAVE_PTYS

1
src/s/ms-w32.h
View File

@ -106,7 +106,6 @@ struct sigaction {
#define HAVE_SOUND 1
#define LISP_FLOAT_TYPE 1
#undef HAVE_SYS_SELECT_H
#define HAVE_SYS_TIMEB_H 1
#define HAVE_SYS_TIME_H 1
#define HAVE_UNISTD_H 1

2
src/s/unixware.h
View File

@ -21,8 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "usg5-4-common.h"
/* fnf@cygnus.com says these exist. */
#define HAVE_TCATTR
/* #define HAVE_GETWD (appears to be buggy on SVR4.2) */
#undef HAVE_GETWD

180
src/sysdep.c
View File

@ -35,15 +35,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#include "lisp.h"
/* Including stdlib.h isn't necessarily enough to get srandom
declared, e.g. without __USE_XOPEN_EXTENDED with glibc 2. */
/* The w32 build defines select stuff in w32.h, which is included by
sys/select.h (included below). */
#ifndef WINDOWSNT
#include "sysselect.h"
#endif
#include "blockinput.h"
#ifdef WINDOWSNT
@ -84,17 +76,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <fcntl.h>
#endif
#ifndef MSDOS
#include <sys/ioctl.h>
#endif
#include "systty.h"
#include "syswait.h"
#if defined (USG)
#ifdef HAVE_SYS_UTSNAME_H
#include <sys/utsname.h>
#include <memory.h>
#endif /* USG */
#endif /* HAVE_SYS_UTSNAME_H */
#include "keyboard.h"
#include "frame.h"
@ -149,17 +137,6 @@ static const int baud_convert[] =
1800, 2400, 4800, 9600, 19200, 38400
};
#ifdef HAVE_SPEED_T
#include <termios.h>
#else
#if defined (HAVE_LIBNCURSES) && ! defined (NCURSES_OSPEED_T)
#else
#if defined (HAVE_TERMIOS_H) && defined (GNU_LINUX)
#include <termios.h>
#endif
#endif
#endif
int emacs_ospeed;
void croak (char *) NO_RETURN;
@ -308,32 +285,11 @@ init_baud_rate (int fd)
#ifdef DOS_NT
emacs_ospeed = 15;
#else /* not DOS_NT */
#ifdef HAVE_TERMIOS
struct termios sg;
sg.c_cflag = B9600;
tcgetattr (fd, &sg);
emacs_ospeed = cfgetospeed (&sg);
#else /* not TERMIOS */
#ifdef HAVE_TERMIO
struct termio sg;
sg.c_cflag = B9600;
#ifdef HAVE_TCATTR
tcgetattr (fd, &sg);
#else
ioctl (fd, TCGETA, &sg);
#endif
emacs_ospeed = sg.c_cflag & CBAUD;
#else /* neither TERMIOS nor TERMIO */
struct sgttyb sg;
sg.sg_ospeed = B9600;
if (ioctl (fd, TIOCGETP, &sg) < 0)
abort ();
emacs_ospeed = sg.sg_ospeed;
#endif /* not HAVE_TERMIO */
#endif /* not HAVE_TERMIOS */
#endif /* not DOS_NT */
}
@ -417,7 +373,7 @@ wait_for_termination (int pid)
void
flush_pending_output (int channel)
{
#ifdef HAVE_TERMIOS
#ifndef DOS_NT
/* If we try this, we get hit with SIGTTIN, because
the child's tty belongs to the child's pgrp. */
#else
@ -447,8 +403,6 @@ child_setup_tty (int out)
struct emacs_tty s;
EMACS_GET_TTY (out, &s);
#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
s.main.c_oflag |= OPOST; /* Enable output postprocessing */
s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */
#ifdef NLDLY
@ -526,19 +480,7 @@ child_setup_tty (int out)
s.main.c_cc[VTIME] = 0;
#endif
#else /* not HAVE_TERMIO */
s.main.sg_flags &= ~(ECHO | CRMOD | ANYP | ALLDELAY | RAW | LCASE
| CBREAK | TANDEM);
s.main.sg_flags |= LPASS8;
s.main.sg_erase = 0377;
s.main.sg_kill = 0377;
s.lmode = LLITOUT | s.lmode; /* Don't strip 8th bit */
#endif /* not HAVE_TERMIO */
EMACS_SET_TTY (out, &s, 0);
#endif /* not WINDOWSNT */
}
#endif /* MSDOS */
@ -841,38 +783,11 @@ int
emacs_get_tty (int fd, struct emacs_tty *settings)
{
/* Retrieve the primary parameters - baud rate, character size, etcetera. */
#ifdef HAVE_TCATTR
#ifndef DOS_NT
/* We have those nifty POSIX tcmumbleattr functions. */
memset (&settings->main, 0, sizeof (settings->main));
if (tcgetattr (fd, &settings->main) < 0)
return -1;
#else
#ifdef HAVE_TERMIO
/* The SYSV-style interface? */
if (ioctl (fd, TCGETA, &settings->main) < 0)
return -1;
#else
#ifndef DOS_NT
/* I give up - I hope you have the BSD ioctls. */
if (ioctl (fd, TIOCGETP, &settings->main) < 0)
return -1;
#endif /* not DOS_NT */
#endif
#endif
/* Suivant - Do we have to get struct ltchars data? */
#ifdef HAVE_LTCHARS
if (ioctl (fd, TIOCGLTC, &settings->ltchars) < 0)
return -1;
#endif
/* How about a struct tchars and a wordful of lmode bits? */
#ifdef HAVE_TCHARS
if (ioctl (fd, TIOCGETC, &settings->tchars) < 0
|| ioctl (fd, TIOCLGET, &settings->lmode) < 0)
return -1;
#endif
/* We have survived the tempest. */
@ -888,7 +803,7 @@ int
emacs_set_tty (int fd, struct emacs_tty *settings, int flushp)
{
/* Set the primary parameters - baud rate, character size, etcetera. */
#ifdef HAVE_TCATTR
#ifndef DOS_NT
int i;
/* We have those nifty POSIX tcmumbleattr functions.
William J. Smith <wjs@wiis.wang.com> writes:
@ -926,34 +841,6 @@ emacs_set_tty (int fd, struct emacs_tty *settings, int flushp)
else
continue;
}
#else
#ifdef HAVE_TERMIO
/* The SYSV-style interface? */
if (ioctl (fd, flushp ? TCSETAF : TCSETAW, &settings->main) < 0)
return -1;
#else
#ifndef DOS_NT
/* I give up - I hope you have the BSD ioctls. */
if (ioctl (fd, (flushp) ? TIOCSETP : TIOCSETN, &settings->main) < 0)
return -1;
#endif /* not DOS_NT */
#endif
#endif
/* Suivant - Do we have to get struct ltchars data? */
#ifdef HAVE_LTCHARS
if (ioctl (fd, TIOCSLTC, &settings->ltchars) < 0)
return -1;
#endif
/* How about a struct tchars and a wordful of lmode bits? */
#ifdef HAVE_TCHARS
if (ioctl (fd, TIOCSETC, &settings->tchars) < 0
|| ioctl (fd, TIOCLSET, &settings->lmode) < 0)
return -1;
#endif
/* We have survived the tempest. */
@ -976,13 +863,6 @@ unsigned char _sobuf[BUFSIZ+8];
char _sobuf[BUFSIZ];
#endif
#ifdef HAVE_LTCHARS
static struct ltchars new_ltchars = {-1,-1,-1,-1,-1,-1};
#endif
#ifdef HAVE_TCHARS
static struct tchars new_tchars = {-1,-1,-1,-1,-1,-1};
#endif
/* Initialize the terminal mode on all tty devices that are currently
open. */
@ -1016,7 +896,7 @@ init_sys_modes (struct tty_display_info *tty_out)
tty = *tty_out->old_tty;
#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
#if !defined (DOS_NT)
XSETINT (Vtty_erase_char, tty.main.c_cc[VERASE]);
tty.main.c_iflag |= (IGNBRK); /* Ignore break condition */
@ -1088,12 +968,11 @@ init_sys_modes (struct tty_display_info *tty_out)
of C-z */
#endif /* VSWTCH */
#if defined (__mips__) || defined (HAVE_TCATTR)
#ifdef VSUSP
tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off mips handling of C-z. */
tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off handling of C-z. */
#endif /* VSUSP */
#ifdef V_DSUSP
tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off mips handling of C-y. */
tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off handling of C-y. */
#endif /* V_DSUSP */
#ifdef VDSUSP /* Some systems have VDSUSP, some have V_DSUSP. */
tty.main.c_cc[VDSUSP] = CDISABLE;
@ -1129,7 +1008,6 @@ init_sys_modes (struct tty_display_info *tty_out)
tty.main.c_cc[VSTOP] = CDISABLE;
#endif /* VSTOP */
}
#endif /* mips or HAVE_TCATTR */
#ifdef AIX
tty.main.c_cc[VSTRT] = CDISABLE;
@ -1152,41 +1030,8 @@ init_sys_modes (struct tty_display_info *tty_out)
tty.main.c_iflag &= ~IGNBRK;
tty.main.c_iflag &= ~BRKINT;
#endif
#else /* if not HAVE_TERMIO */
#ifndef DOS_NT
XSETINT (Vtty_erase_char, tty.main.sg_erase);
tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS);
if (meta_key)
tty.main.sg_flags |= ANYP;
tty.main.sg_flags |= interrupt_input ? RAW : CBREAK;
#endif /* not DOS_NT */
#endif /* not HAVE_TERMIO */
/* If going to use CBREAK mode, we must request C-g to interrupt
and turn off start and stop chars, etc. If not going to use
CBREAK mode, do this anyway so as to turn off local flow
control for user coming over network on 4.2; in this case,
only t_stopc and t_startc really matter. */
#ifndef HAVE_TERMIO
#ifdef HAVE_TCHARS
/* Note: if not using CBREAK mode, it makes no difference how we
set this */
tty.tchars = new_tchars;
tty.tchars.t_intrc = quit_char;
if (tty_out->flow_control)
{
tty.tchars.t_startc = '\021';
tty.tchars.t_stopc = '\023';
}
tty.lmode = LDECCTQ | LLITOUT | LPASS8 | LNOFLSH | tty_out->old_tty.lmode;
#endif /* HAVE_TCHARS */
#endif /* not HAVE_TERMIO */
#ifdef HAVE_LTCHARS
tty.ltchars = new_ltchars;
#endif /* HAVE_LTCHARS */
#ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */
if (!tty_out->term_initted)
internal_terminal_init ();
@ -1205,7 +1050,7 @@ init_sys_modes (struct tty_display_info *tty_out)
if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TIOCSTART, 0);
#endif
#if defined (HAVE_TERMIOS) || defined (HPUX)
#if !defined (DOS_NT)
#ifdef TCOON
if (!tty_out->flow_control) tcflow (fileno (tty_out->input), TCOON);
#endif
@ -2688,7 +2533,7 @@ strsignal (int code)
}
#endif /* HAVE_STRSIGNAL */
#ifdef HAVE_TERMIOS
#ifndef DOS_NT
/* For make-serial-process */
int
serial_open (char *port)
@ -2717,9 +2562,6 @@ serial_open (char *port)
return fd;
}
#endif /* TERMIOS */
#ifdef HAVE_TERMIOS
#if !defined (HAVE_CFMAKERAW)
/* Workaround for targets which are missing cfmakeraw. */
@ -2906,7 +2748,7 @@ serial_configure (struct Lisp_Process *p,
p->childp = childp2;
}
#endif /* TERMIOS */
#endif /* not DOS_NT */
/* System depended enumeration of and access to system processes a-la ps(1). */

5
src/sysselect.h
View File

@ -27,6 +27,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#endif
#endif
/* The w32 build defines select stuff in w32.h, which is included
where w32 needs it, but not where sysselect.h is included. The w32
definitions in w32.h are incompatible with the below. */
#ifndef WINDOWSNT
#ifdef FD_SET
#ifdef FD_SETSIZE
#define MAXDESC FD_SETSIZE
@ -44,6 +48,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define FD_ISSET(n, p) (*(p) & (1 << (n)))
#define FD_ZERO(p) (*(p) = 0)
#endif /* no FD_SET */
#endif /* not WINDOWSNT */
#if !defined (HAVE_SELECT)
#define select sys_select

124
src/systty.h
View File

@ -17,34 +17,17 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef HAVE_TERMIOS
#define HAVE_TCATTR
#endif
/* Include the proper files. */
#ifdef HAVE_TERMIO
#ifndef DOS_NT
#ifndef NO_TERMIO
#include <termio.h>
#endif /* not NO_TERMIO */
#include <fcntl.h>
#else /* not HAVE_TERMIO */
#ifdef HAVE_TERMIOS
#ifndef NO_TERMIO
#include <termio.h>
#endif
#include <termios.h>
#include <fcntl.h>
#else /* neither HAVE_TERMIO nor HAVE_TERMIOS */
#ifndef DOS_NT
#include <sgtty.h>
#endif /* not DOS_NT */
#endif /* not HAVE_TERMIOS */
#endif /* not HAVE_TERMIO */
#ifdef __GNU_LIBRARY__
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#include <termios.h>
#endif
#ifdef HPUX
@ -74,17 +57,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef SIGIO
#endif
/* On TERMIOS systems, the tcmumbleattr calls take care of these
parameters, and it's a bad idea to use them (on AIX, it makes the
tty hang for a long time). */
#if defined (TIOCGLTC) && !defined (HAVE_TERMIOS)
#define HAVE_LTCHARS
#endif
#if defined (TIOCGETC) && !defined (HAVE_TERMIOS)
#define HAVE_TCHARS
#endif
/* Try to establish the correct character to disable terminal functions
in a system-independent manner. Note that USG (at least) define
@ -111,60 +83,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TIOCOUTQ, (size)))
#endif
#ifdef HAVE_TERMIO
#ifdef TCOUTQ
#undef EMACS_OUTQSIZE
#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TCOUTQ, (size)))
#endif
#endif
/* Manipulate a terminal's current process group. */
/* EMACS_HAVE_TTY_PGRP is true if we can get and set the tty's current
controlling process group.
EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's
/* EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's
current process group. Return -1 if there is an error.
EMACS_SET_TTY_PGRP(int FD, int *PGID) sets the terminal FD's
current process group to *PGID. Return -1 if there is an error. */
/* HPUX tty process group stuff doesn't work, says the anonymous voice
from the past. */
#ifndef HPUX
#ifdef TIOCGPGRP
#define EMACS_HAVE_TTY_PGRP
#else
#ifdef HAVE_TERMIOS
#define EMACS_HAVE_TTY_PGRP
#endif /* HAVE_TERMIOS */
#endif /* TIOCGPGRP */
#endif /* not HPUX */
#ifdef EMACS_HAVE_TTY_PGRP
#if defined (HAVE_TERMIOS)
#ifndef DOS_NT
#define EMACS_GET_TTY_PGRP(fd, pgid) (*(pgid) = tcgetpgrp ((fd)))
#define EMACS_SET_TTY_PGRP(fd, pgid) (tcsetpgrp ((fd), *(pgid)))
#else /* not HAVE_TERMIOS */
#ifdef TIOCSPGRP
#define EMACS_GET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCGPGRP, (pgid)))
#define EMACS_SET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCSPGRP, (pgid)))
#endif /* TIOCSPGRP */
#endif /* HAVE_TERMIOS */
#else /* not EMACS_SET_TTY_PGRP */
/* Just ignore this for now and hope for the best */
#define EMACS_GET_TTY_PGRP(fd, pgid) 0
#define EMACS_SET_TTY_PGRP(fd, pgif) 0
#endif /* not EMACS_SET_TTY_PGRP */
#endif /* not DOS_NT */
/* EMACS_GETPGRP (arg) returns the process group of the process. */
@ -207,32 +138,11 @@ struct emacs_tty {
/* There is always one of the following elements, so there is no need
for dummy get and set definitions. */
#ifdef HAVE_TCATTR
#ifndef DOS_NT
struct termios main;
#else /* not HAVE_TCATTR */
#ifdef HAVE_TERMIO
struct termio main;
#else /* not HAVE_TERMIO */
#ifdef DOS_NT
#else /* DOS_NT */
int main;
#else /* not DOS_NT */
struct sgttyb main;
#endif /* not DOS_NT */
#endif /* not HAVE_TERMIO */
#endif /* not HAVE_TCATTR */
/* If we have TERMIOS, we don't need to do this - they're taken care of
by the tc*attr calls. */
#ifndef HAVE_TERMIOS
#ifdef HAVE_LTCHARS
struct ltchars ltchars;
#endif /* HAVE_LTCHARS */
#ifdef HAVE_TCHARS
struct tchars tchars;
int lmode;
#endif /* HAVE_TCHARS */
#endif /* not defined HAVE_TERMIOS */
#endif /* DOS_NT */
};
/* Define EMACS_GET_TTY and EMACS_SET_TTY,
@ -249,7 +159,7 @@ extern int emacs_set_tty (int, struct emacs_tty *, int);
/* Define EMACS_TTY_TABS_OK. */
#ifdef HAVE_TERMIOS
#ifndef DOS_NT
#ifdef TABDLY
#define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3)
@ -257,21 +167,9 @@ extern int emacs_set_tty (int, struct emacs_tty *, int);
#define EMACS_TTY_TABS_OK(p) 1
#endif /* not TABDLY */
#else /* not def HAVE_TERMIOS */
#ifdef HAVE_TERMIO
#define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3)
#else /* neither HAVE_TERMIO nor HAVE_TERMIOS */
#ifdef DOS_NT
#else /* DOS_NT */
#define EMACS_TTY_TABS_OK(p) 0
#else /* not DOS_NT */
#define EMACS_TTY_TABS_OK(p) (((p)->main.sg_flags & XTABS) != XTABS)
#endif /* not DOS_NT */
#endif /* not def HAVE_TERMIO */
#endif /* not def HAVE_TERMIOS */
#endif /* DOS_NT */
/* arch-tag: cf4b90bc-be41-401c-be98-40619178a712
(do not change this comment) */

3
src/term.c
View File

@ -31,9 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#endif
#if HAVE_TERMIOS_H
#include <termios.h> /* For TIOCNOTTY. */
#endif
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#endif

64
src/unexcoff.c
View File

@ -84,6 +84,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifdef MSDOS
#include <fcntl.h> /* for O_RDONLY, O_RDWR */
#include <crt0.h> /* for _crt0_startup_flags and its bits */
#include <sys/exceptn.h>
static int save_djgpp_startup_flags;
#define filehdr external_filehdr
#define scnhdr external_scnhdr
@ -128,7 +129,7 @@ struct aouthdr
#endif
extern char *start_of_data (); /* Start of initialized data */
extern char *start_of_data (void); /* Start of initialized data */
static long block_copy_start; /* Old executable start point */
static struct filehdr f_hdr; /* File header */
@ -153,10 +154,8 @@ static int pagemask;
#include <setjmp.h>
#include "lisp.h"
static
report_error (file, fd)
char *file;
int fd;
static void
report_error (const char *file, int fd)
{
if (fd)
close (fd);
@ -167,20 +166,18 @@ report_error (file, fd)
#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1
#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1
static
report_error_1 (fd, msg, a1, a2)
int fd;
char *msg;
int a1, a2;
static void
report_error_1 (int fd, const char *msg, int a1, int a2)
{
close (fd);
error (msg, a1, a2);
}
static int make_hdr ();
static int copy_text_and_data ();
static int copy_sym ();
static void mark_x ();
static int make_hdr (int, int, unsigned, unsigned, unsigned,
const char *, const char *);
static int copy_text_and_data (int, int);
static int copy_sym (int, int, const char *, const char *);
static void mark_x (const char *);
/* ****************************************************************
* make_hdr
@ -189,13 +186,9 @@ static void mark_x ();
* Modify the text and data sizes.
*/
static int
make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name)
int new, a_out;
unsigned data_start, bss_start, entry_address;
char *a_name;
char *new_name;
make_hdr (int new, int a_out, unsigned data_start, unsigned bss_start,
unsigned entry_address, const char *a_name, const char *new_name)
{
int tem;
auto struct scnhdr f_thdr; /* Text section header */
auto struct scnhdr f_dhdr; /* Data section header */
auto struct scnhdr f_bhdr; /* Bss section header */
@ -363,12 +356,10 @@ make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name)
}
write_segment (new, ptr, end)
int new;
register char *ptr, *end;
void
write_segment (int new, const char *ptr, const char *end)
{
register int i, nwrite, ret;
char buf[80];
/* This is the normal amount to write at once.
It is the size of block that NFS uses. */
int writesize = 1 << 13;
@ -411,8 +402,7 @@ write_segment (new, ptr, end)
* Copy the text and data segments from memory to the new a.out
*/
static int
copy_text_and_data (new, a_out)
int new, a_out;
copy_text_and_data (int new, int a_out)
{
register char *end;
register char *ptr;
@ -456,9 +446,7 @@ copy_text_and_data (new, a_out)
* Copy the relocation information and symbol table from the a.out to the new
*/
static int
copy_sym (new, a_out, a_name, new_name)
int new, a_out;
char *a_name, *new_name;
copy_sym (int new, int a_out, const char *a_name, const char *new_name)
{
char page[1024];
int n;
@ -494,8 +482,7 @@ copy_sym (new, a_out, a_name, new_name)
* After successfully building the new a.out, mark it executable
*/
static void
mark_x (name)
char *name;
mark_x (const char *name)
{
struct stat sbuf;
int um;
@ -535,10 +522,8 @@ mark_x (name)
a reasonable size buffer. But I don't have time to work on such
things, so I am installing it as submitted to me. -- RMS. */
adjust_lnnoptrs (writedesc, readdesc, new_name)
int writedesc;
int readdesc;
char *new_name;
int
adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name)
{
register int nsyms;
register int new;
@ -585,11 +570,11 @@ adjust_lnnoptrs (writedesc, readdesc, new_name)
*
* driving logic.
*/
unexec (new_name, a_name, data_start, bss_start, entry_address)
char *new_name, *a_name;
unsigned data_start, bss_start, entry_address;
int
unexec (const char *new_name, const char *a_name,
unsigned data_start, unsigned bss_start, unsigned entry_address)
{
int new, a_out = -1;
int new = -1, a_out = -1;
if (a_name && (a_out = open (a_name, O_RDONLY)) < 0)
{
@ -607,7 +592,6 @@ unexec (new_name, a_name, data_start, bss_start, entry_address)
)
{
close (new);
/* unlink (new_name); /* Failed, unlink new a.out */
return -1;
}

7
src/w32fns.c
View File

@ -3109,9 +3109,6 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
HIMC context;
struct window *w;
if (!context)
break;
f = x_window_to_frame (dpyinfo, hwnd);
w = XWINDOW (FRAME_SELECTED_WINDOW (f));
@ -3129,6 +3126,10 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
- WINDOW_MODE_LINE_HEIGHT (w));
context = get_ime_context_fn (hwnd);
if (!context)
break;
set_ime_composition_window_fn (context, &form);
release_ime_context_fn (hwnd, context);
}

6
src/w32menu.c
View File

@ -420,12 +420,8 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
set_buffer_internal_1 (XBUFFER (buffer));
/* Run the Lucid hook. */
/* Run the hooks. */
safe_run_hooks (Qactivate_menubar_hook);
/* If it has changed current-menubar from previous value,
really recompute the menubar from the value. */
if (! NILP (Vlucid_menu_bar_dirty_flag))
call0 (Qrecompute_lucid_menubar);
safe_run_hooks (Qmenu_bar_update_hook);
FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));

23
src/xdisp.c
View File

@ -217,7 +217,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
glyph with suitably computed width. Both the blanks and the
stretch glyph are given the face of the background of the line.
This way, the terminal-specific back-end can still draw the glyphs
left to right, even for R2L lines. */
left to right, even for R2L lines.
Note one important detail mentioned above: that the bidi reordering
engine, driven by the iterator, produces characters in R2L rows
starting at the character that will be the rightmost on display.
As far as the iterator is concerned, the geometry of such rows is
still left to right, i.e. the iterator "thinks" the first character
is at the leftmost pixel position. The iterator does not know that
PRODUCE_GLYPHS reverses the order of the glyphs that the iterator
delivers. This is important when functions from the the move_it_*
family are used to get to certain screen position or to match
screen coordinates with buffer coordinates: these functions use the
iterator geometry, which is left to right even in R2L paragraphs.
This works well with most callers of move_it_*, because they need
to get to a specific column, and columns are still numbered in the
reading order, i.e. the rightmost character in a R2L paragraph is
still column zero. But some callers do not get well with this; a
notable example is mouse clicks that need to find the character
that corresponds to certain pixel coordinates. See
buffer_posn_from_coords in dispnew.c for how this is handled. */
#include <config.h>
#include <stdio.h>
@ -10839,7 +10858,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y)
enum draw_glyphs_face draw = DRAW_IMAGE_RAISED;
int mouse_down_p, rc;
/* Function note_mouse_highlight is called with negative x(y
/* Function note_mouse_highlight is called with negative X/Y
values when mouse moves outside of the frame. */
if (x <= 0 || y <= 0)
{