Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge from trunk, resolve conflicts.

Browse source
This commit is contained in:
Eli Zaretskii 2013-04-14 20:27:45 +03:00
commit eb7a410c14
84 changed files with 1782 additions and 911 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
ChangeLog
View file

@ -1,3 +1,22 @@
2013-04-12 Ken Brown <kbrown@cornell.edu>
* configure.ac (canonical): Adapt to 64-bit Cygwin, for which
`canonical' is `x86_64-unknown-cygwin'.
2013-04-09 Ken Brown <kbrown@cornell.edu>
* configure.ac (W32_RES_LINK): Remove unneeded linker directive
`-Wl,-bpe-i386', which is confusing in the 64-bit case.
(Bug#12993)
2013-04-07 Paul Eggert <eggert@cs.ucla.edu>
Fix --enable-profiling bug introduced by 2013-02-25 change (Bug#13783).
* configure.ac (LD_SWITCH_SYSTEM_TEMACS): Append -pg if profiling
and if not on GNU/Linux or FreeBSD.
* lib/Makefile.am (AM_CFLAGS): Add $(PROFILING_CFLAGS), so that
lib/*.o is profiled too.
2013-03-30 Paul Eggert <eggert@cs.ucla.edu>
Merge from gnulib, incorporating:

2
admin/notes/bugtracker
View file

@ -103,7 +103,7 @@ This is annoying.
to hopefully stop this happening, but it is still better to use X-Debbugs-CC.)
If a new report contains X-Debbugs-CC in the input, this is
converted to a real Cc header in the output. (See Bug#1720).
converted to a real Cc header in the output. (See Bug#1780,5384)
It is also merged into the Resent-CC header (see below).
** How does Debbugs send out mails?

2
autogen/Makefile.in
View file

@ -1019,7 +1019,7 @@ MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t dirent.h \
string.h-t sys/select.h sys/select.h-t sys/stat.h sys/stat.h-t \
sys/time.h sys/time.h-t time.h time.h-t unistd.h unistd.h-t
noinst_LIBRARIES = libgnu.a
AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
AM_CFLAGS = $(PROFILING_CFLAGS) $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src
libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \
c-strcasecmp.c c-strncasecmp.c careadlinkat.c close-stream.c \

15
autogen/configure vendored
View file

@ -4672,6 +4672,11 @@ case "${canonical}" in
## fi
;;
## Cygwin ports
*-*-cygwin )
opsys=cygwin
;;
## HP 9000 series 700 and 800, running HP/UX
hppa*-hp-hpux10.2* )
opsys=hpux10-20
@ -4745,7 +4750,6 @@ case "${canonical}" in
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
case "${canonical}" in
*-cygwin ) opsys=cygwin ;;
*-darwin* ) opsys=darwin ;;
*-sysv4.2uw* ) opsys=unixware ;;
*-sysv5uw* ) opsys=unixware ;;
@ -9842,7 +9846,7 @@ fi
W32_RES="emacs.res"
# Tell the linker that emacs.res is an object (which we compile from
# the rc file), not a linker script.
W32_RES_LINK="-Wl,-bpe-i386 -Wl,emacs.res"
W32_RES_LINK="-Wl,emacs.res"
fi
@ -26667,6 +26671,13 @@ case "$opsys" in
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
if test x$ac_enable_profiling != x ; then
case $opsys in
*freebsd | gnu-linux) ;;
*) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -pg" ;;
esac
fi
## Common for all window systems

15
configure.ac
View file

@ -471,6 +471,11 @@ case "${canonical}" in
## fi
;;
## Cygwin ports
*-*-cygwin )
opsys=cygwin
;;
## HP 9000 series 700 and 800, running HP/UX
hppa*-hp-hpux10.2* )
opsys=hpux10-20
@ -544,7 +549,6 @@ case "${canonical}" in
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
case "${canonical}" in
*-cygwin ) opsys=cygwin ;;
*-darwin* ) opsys=darwin ;;
*-mingw32 )
opsys=mingw32
@ -1596,7 +1600,7 @@ if test "${HAVE_W32}" = "yes"; then
W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool"
# Tell the linker that emacs.res is an object (which we compile from
# the rc file), not a linker script.
W32_RES_LINK="-Wl,-bpe-i386 -Wl,emacs.res"
W32_RES_LINK="-Wl,emacs.res"
else
W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o"
W32_OBJ="$W32_OBJ w32notify.o"
@ -4450,6 +4454,13 @@ case "$opsys" in
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
if test x$ac_enable_profiling != x ; then
case $opsys in
*freebsd | gnu-linux) ;;
*) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -pg" ;;
esac
fi
AC_SUBST(LD_SWITCH_SYSTEM_TEMACS)
## MinGW-specific post-link processing of temacs.

16
doc/lispref/ChangeLog
View file

@ -1,3 +1,19 @@
2013-04-13 Stephen Berman <stephen.berman@gmx.net>
* windows.texi (Splitting Windows): Change category of
split-window from a command to a function.
2013-04-06 Chong Yidong <cyd@gnu.org>
* display.texi (Faces): Minor clarifications.
(Defining Faces): Clarify default vs custom face specs. Document
face-spec-set.
* display.texi (Overlay Properties):
* text.texi (Special Properties): Use the "anonymous face"
terminology. Describe foreground-color and background-color forms
as compatibility-only.
2013-03-24 Eli Zaretskii <eliz@gnu.org>
* compile.texi (Byte-Code Objects): Add index entry.

287
doc/lispref/display.texi
View file

@ -1510,31 +1510,31 @@ of the symbol serve as defaults for the properties of the overlay.
@item face
@kindex face @r{(overlay property)}
This property controls the way text is displayed---for example, which
font and which colors. @xref{Faces}, for more information.
In the simplest case, the value is a face name. It can also be a list;
then each element can be any of these possibilities:
This property controls the appearance of the text (@pxref{Faces}).
The value of the property can be the following:
@itemize @bullet
@item
A face name (a symbol or string).
@item
A property list of face attributes. This has the form (@var{keyword}
@var{value} @dots{}), where each @var{keyword} is a face attribute
name and @var{value} is a meaningful value for that attribute. With
this feature, you do not need to create a face each time you want to
specify a particular attribute for certain text. @xref{Face
Attributes}.
An anonymous face: a property list of the form @code{(@var{keyword}
@var{value} @dots{})}, where each @var{keyword} is a face attribute
name and @var{value} is a value for that attribute.
@item
A cons cell, of the form @code{(foreground-color . @var{color-name})}
or @code{(background-color . @var{color-name})}. These elements
specify just the foreground color or just the background color.
A list of faces. Each list element should be either a face name or an
anonymous face. This specifies a face which is an aggregate of the
attributes of each of the listed faces. Faces occurring earlier in
the list have higher priority.
@code{(foreground-color . @var{color-name})} has the same effect as
@code{(:foreground @var{color-name})}; likewise for the background.
@item
A cons cell of the form @code{(foreground-color . @var{color-name})}
or @code{(background-color . @var{color-name})}. This specifies the
foreground or background color, similar to @code{(:foreground
@var{color-name})} or @code{(:background @var{color-name})}. This
form is supported for backward compatibility only, and should be
avoided.
@end itemize
@item mouse-face
@ -1901,44 +1901,39 @@ height.
@section Faces
@cindex faces
A @dfn{face} is a collection of graphical @dfn{attributes} for
displaying text: font, foreground color, background color, optional
underlining, etc. Faces control how Emacs displays text in buffers,
as well as other parts of the frame such as the mode line.
A @dfn{face} is a collection of graphical attributes for displaying
text: font, foreground color, background color, optional underlining,
etc. Faces control how Emacs displays text in buffers, as well as
other parts of the frame such as the mode line.
@cindex anonymous face
One way to represent a face is as a property list of attributes,
like @code{(:foreground "red" :weight bold)}. For example, you can
assign such an @dfn{anonymous face} as the value of the @code{face}
text property; this causes Emacs to display the underlying text with
the specified attributes. @xref{Special Properties}.
like @code{(:foreground "red" :weight bold)}. Such a list is called
an @dfn{anonymous face}. For example, you can assign an anonymous
face as the value of the @code{face} text property, and Emacs will
display the underlying text with the specified attributes.
@xref{Special Properties}.
@cindex face name
More commonly, a face is referred to via a @dfn{face name}: a Lisp
symbol which is associated with a set of face attributes. Named faces
are defined using the @code{defface} macro (@pxref{Defining Faces}).
Emacs defines several standard named faces; @xref{Standard Faces,,,
emacs, The GNU Emacs Manual}.
symbol associated with a set of face attributes@footnote{For backward
compatibility, you can also use a string to specify a face name; that
is equivalent to a Lisp symbol with the same name.}. Named faces are
defined using the @code{defface} macro (@pxref{Defining Faces}).
Emacs comes with several standard named faces (@pxref{Basic Faces}).
Many parts of Emacs require named faces, and do not accept anonymous
faces. These include the functions documented in @ref{Attribute
Functions}, and the variable @code{font-lock-keywords}
Many parts of Emacs required named faces, and do not accept
anonymous faces. These include the functions documented in
@ref{Attribute Functions}, and the variable @code{font-lock-keywords}
(@pxref{Search-based Fontification}). Unless otherwise stated, we
will use the term @dfn{face} to refer only to named faces.
For backward compatibility, you can also use a string to specify a
face name; that is equivalent to a Lisp symbol with the same name.
@defun facep object
This function returns a non-@code{nil} value if @var{object} is a
named face: a Lisp symbol or string which serves as a face name.
Otherwise, it returns @code{nil}.
@end defun
By default, each face name corresponds to the same set of attributes
in all frames. But you can also assign a face name a special set of
attributes in one frame (@pxref{Attribute Functions}).
@menu
* Face Attributes:: What is in a face?
* Defining Faces:: How to define a face.
@ -2178,32 +2173,47 @@ suitable for use with @code{:stipple} (see above). It returns
@node Defining Faces
@subsection Defining Faces
@cindex face spec
The usual way to define a face is through the @code{defface} macro.
This macro defines a face name, and associates that name with a set of
face attributes. It also sets up the face so that the user can
customize it via the Customize interface (@pxref{Customization}).
This macro associates a face name (a symbol) with a default @dfn{face
spec}. A face spec is a construct which specifies what attributes a
face should have on any given terminal; for example, a face spec might
specify one foreground color on high-color terminals, and a different
foreground color on low-color terminals.
People are sometimes tempted to create a variable whose value is a
face name. In the vast majority of cases, this is not necessary; the
usual procedure is to define a face with @code{defface}, and then use
its name directly.
@defmac defface face spec doc [keyword value]@dots{}
This macro declares @var{face} as a customizable face whose default
attributes are given by @var{spec}. You should not quote the symbol
@var{face}, and it should not end in @samp{-face} (that would be
redundant). The argument @var{doc} is a documentation string for the
face. The additional @var{keyword} arguments have the same meanings
as in @code{defgroup} and @code{defcustom} (@pxref{Common Keywords}).
This macro declares @var{face} as a named face whose default face spec
is given by @var{spec}. You should not quote the symbol @var{face},
and it should not end in @samp{-face} (that would be redundant). The
argument @var{doc} is a documentation string for the face. The
additional @var{keyword} arguments have the same meanings as in
@code{defgroup} and @code{defcustom} (@pxref{Common Keywords}).
When @code{defface} executes, it defines the face according to
@var{spec}, then uses any customizations that were read from the
init file (@pxref{Init File}) to override that specification.
If @var{face} already has a default face spec, this macro does
nothing.
When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs
Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun}
overrides any customizations of the face. This way, the face reflects
exactly what the @code{defface} says.
The default face spec determines @var{face}'s appearance when no
customizations are in effect (@pxref{Customization}). If @var{face}
has already been customized (via Custom themes or via customizations
read from the init file), its appearance is determined by the custom
face spec(s), which override the default face spec @var{spec}.
However, if the customizations are subsequently removed, the
appearance of @var{face} will again be determined by its default face
spec.
@cindex face specification
The @var{spec} argument is a @dfn{face specification}, which states
how the face should appear on different kinds of terminals. It should
be an alist whose elements each have the form
As an exception, if you evaluate a @code{defface} form with
@kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature
of @code{eval-defun} overrides any custom face specs on the face,
causing the face to reflect exactly what the @code{defface} says.
The @var{spec} argument is a @dfn{face spec}, which states how the
face should appear on different kinds of terminals. It should be an
alist whose elements each have the form
@example
(@var{display} . @var{plist})
@ -2275,7 +2285,8 @@ terminal must match one of the @var{value}s specified for it in
@end table
@end defmac
Here's how the standard face @code{highlight} is defined:
For example, here's the definition of the standard face
@code{highlight}:
@example
(defface highlight
@ -2294,65 +2305,56 @@ terminal must match one of the @var{value}s specified for it in
:group 'basic-faces)
@end example
Internally, Emacs stores the face's default specification in its
Internally, Emacs stores each face's default spec in its
@code{face-defface-spec} symbol property (@pxref{Symbol Properties}).
The @code{saved-face} property stores the face specification saved by
the user, using the customization buffer; the @code{customized-face}
property stores the face specification customized for the current
session, but not saved; and the @code{theme-face} property stores an
alist associating the active customization settings and Custom themes
with their specifications for that face. The face's documentation
string is stored in the @code{face-documentation} property. But
normally you should not try to set any of these properties directly.
@xref{Applying Customizations}, for the @code{custom-set-faces}
function, which is used to apply customized face settings.
The @code{saved-face} property stores any face spec saved by the user
using the customization buffer; the @code{customized-face} property
stores the face spec customized for the current session, but not
saved; and the @code{theme-face} property stores an alist associating
the active customization settings and Custom themes with the face
specs for that face. The face's documentation string is stored in the
@code{face-documentation} property.
People are sometimes tempted to create variables whose values
specify a face to use. In the vast majority of cases, this is not
necessary; it is preferable to simply use faces directly.
Normally, a face is declared just once, using @code{defface}, and
any further changes to its appearance are applied using the Customize
framework (e.g., via the Customize user interface or via the
@code{custom-set-faces} function; @pxref{Applying Customizations}), or
by face remapping (@pxref{Face Remapping}). In the rare event that
you need to change a face spec directly from Lisp, you can use the
@code{face-spec-set} function.
@defun face-spec-set face spec &optional spec-type
This function applies @var{spec} as a face spec for @code{face}.
@var{spec} should be a face spec, as described in the above
documentation for @code{defface}.
@cindex override spec @r{(for a face)}
The argument @var{spec-type} determines which spec to set. If it is
@code{nil} or @code{face-override-spec}, this function sets the
@dfn{override spec}, which overrides over all other face specs on
@var{face}. If it is @code{face-defface-spec}, this function sets the
default face spec (the same one set by @code{defface}). If it is
@code{reset}, this function clears out all customization specs and
override specs from @var{face} (in this case, the value of @var{spec}
is ignored). Any other value of @var{spec-type} is reserved for
internal use.
@end defun
@node Attribute Functions
@subsection Face Attribute Functions
This section describes the functions for accessing and modifying the
attributes of an existing named face.
@defun set-face-attribute face frame &rest arguments
This function sets one or more attributes of @var{face} for
@var{frame}. The attributes you specify this way override whatever
the @code{defface} says.
The extra arguments @var{arguments} specify the attributes to set, and
the values for them. They should consist of alternating attribute
names (such as @code{:family} or @code{:underline}) and values. Thus,
@example
(set-face-attribute 'foo nil
:width 'extended
:weight 'bold)
@end example
@noindent
sets the attribute @code{:width} to @code{extended} and the attribute
@code{:weight} to @code{bold}.
If @var{frame} is @code{t}, this function sets the default attributes
for new frames. Default attribute values specified this way override
the @code{defface} for newly created frames.
If @var{frame} is @code{nil}, this function sets the attributes for
all existing frames, and the default for new frames.
@end defun
This section describes functions for directly accessing and
modifying the attributes of a named face.
@defun face-attribute face attribute &optional frame inherit
This returns the value of the @var{attribute} attribute of @var{face}
on @var{frame}. If @var{frame} is @code{nil}, that means the selected
frame (@pxref{Input Focus}).
This function returns the value of the @var{attribute} attribute for
@var{face} on @var{frame}.
If @var{frame} is @code{t}, this returns whatever new-frames default
value you previously specified with @code{set-face-attribute} for the
@var{attribute} attribute of @var{face}. If you have not specified
one, it returns @code{nil}.
If @var{frame} is @code{nil}, that means the selected frame
(@pxref{Input Focus}). If @var{frame} is @code{t}, this function
returns the value of the specified attribute for newly-created frames
(this is normally @code{unspecified}, unless you have specified some
value using @code{set-face-attribute}; see below).
If @var{inherit} is @code{nil}, only attributes directly defined by
@var{face} are considered, so the return value may be
@ -2409,6 +2411,36 @@ If @var{value1} is a relative value for the face attribute
@var{attribute}, returns it merged with the underlying value
@var{value2}; otherwise, if @var{value1} is an absolute value for the
face attribute @var{attribute}, returns @var{value1} unchanged.
@end defun
Normally, Emacs uses the face specs of each face to automatically
calculate its attributes on each frame (@pxref{Defining Faces}). The
function @code{set-face-attribute} can override this calculation by
directly assigning attributes to a face, either on a specific frame or
for all frames. This function is mostly intended for internal usage.
@defun set-face-attribute face frame &rest arguments
This function sets one or more attributes of @var{face} for
@var{frame}. The attributes specifies in this way override the face
spec(s) belonging to @var{face}.
The extra arguments @var{arguments} specify the attributes to set, and
the values for them. They should consist of alternating attribute
names (such as @code{:family} or @code{:underline}) and values. Thus,
@example
(set-face-attribute 'foo nil :weight 'bold :slant 'italic)
@end example
@noindent
sets the attribute @code{:weight} to @code{bold} and the attribute
@code{:slant} to @code{italic}.
If @var{frame} is @code{t}, this function sets the default attributes
for newly created frames. If @var{frame} is @code{nil}, this function
sets the attributes for all existing frames, as well as for newly
created frames.
@end defun
The following commands and functions mostly provide compatibility
@ -2457,16 +2489,17 @@ This sets the @code{:inverse-video} attribute of @var{face} to
This swaps the foreground and background colors of face @var{face}.
@end deffn
The following functions examine the attributes of a face. If you
don't specify @var{frame}, they refer to the selected frame; @code{t}
refers to the default data for new frames. They return the symbol
@code{unspecified} if the face doesn't define any value for that
attribute. If @var{inherit} is @code{nil}, only an attribute directly
defined by the face is returned. If @var{inherit} is non-@code{nil},
any faces specified by its @code{:inherit} attribute are considered as
well, and if @var{inherit} is a face or a list of faces, then they are
also considered, until a specified attribute is found. To ensure that
the return value is always specified, use a value of @code{default} for
The following functions examine the attributes of a face. They
mostly provide compatibility with old versions of Emacs. If you don't
specify @var{frame}, they refer to the selected frame; @code{t} refers
to the default data for new frames. They return @code{unspecified} if
the face doesn't define any value for that attribute. If
@var{inherit} is @code{nil}, only an attribute directly defined by the
face is returned. If @var{inherit} is non-@code{nil}, any faces
specified by its @code{:inherit} attribute are considered as well, and
if @var{inherit} is a face or a list of faces, then they are also
considered, until a specified attribute is found. To ensure that the
return value is always specified, use a value of @code{default} for
@var{inherit}.
@defun face-font face &optional frame
@ -2576,13 +2609,13 @@ The value of this variable is an alist whose elements have the form
any text having the face @var{face} with @var{remapping}, rather than
the ordinary definition of @var{face}.
@var{remapping} may be any face specification suitable for a
@code{face} text property: either a face (i.e., a face name or a
property list of attribute/value pairs), or a list of faces. For
details, see the description of the @code{face} text property in
@ref{Special Properties}. @var{remapping} serves as the complete
specification for the remapped face---it replaces the normal
definition of @var{face}, instead of modifying it.
@var{remapping} may be any face spec suitable for a @code{face} text
property: either a face (i.e., a face name or a property list of
attribute/value pairs), or a list of faces. For details, see the
description of the @code{face} text property in @ref{Special
Properties}. @var{remapping} serves as the complete specification for
the remapped face---it replaces the normal definition of @var{face},
instead of modifying it.
If @code{face-remapping-alist} is buffer-local, its local value takes
effect only within that buffer.
@ -2629,7 +2662,7 @@ and @code{face-remap-reset-base} functions; it is intended for major
modes to remap faces in the buffers they control.
@defun face-remap-add-relative face &rest specs
This functions adds the face specifications in @var{specs} as relative
This functions adds the face spec in @var{specs} as relative
remappings for face @var{face} in the current buffer. The remaining
arguments, @var{specs}, should form either a list of face names, or a
property list of attribute/value pairs.

28
doc/lispref/text.texi
View file

@ -3008,27 +3008,31 @@ character.
@item face
@cindex face codes of text
@kindex face @r{(text property)}
The @code{face} property controls the appearance of the character,
such as its font and color. @xref{Faces}. The value of the property
can be the following:
The @code{face} property controls the appearance of the character
(@pxref{Faces}). The value of the property can be the following:
@itemize @bullet
@item
A face name (a symbol or string).
@item
A property list of face attributes. This has the form (@var{keyword}
@var{value} @dots{}), where each @var{keyword} is a face attribute
name and @var{value} is a meaningful value for that attribute. With
this feature, you do not need to create a face each time you want to
specify a particular attribute for certain text.
An anonymous face: a property list of the form @code{(@var{keyword}
@var{value} @dots{})}, where each @var{keyword} is a face attribute
name and @var{value} is a value for that attribute.
@item
A list of faces. This specifies a face which is an aggregate of the
A list of faces. Each list element should be either a face name or an
anonymous face. This specifies a face which is an aggregate of the
attributes of each of the listed faces. Faces occurring earlier in
the list have higher priority. Each list element must have one of the
two above forms (i.e., either a face name or a property list of face
attributes).
the list have higher priority.
@item
A cons cell of the form @code{(foreground-color . @var{color-name})}
or @code{(background-color . @var{color-name})}. This specifies the
foreground or background color, similar to @code{(:foreground
@var{color-name})} or @code{(:background @var{color-name})}. This
form is supported for backward compatibility only, and should be
avoided.
@end itemize
Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by

4
doc/lispref/windows.texi
View file

@ -717,7 +717,7 @@ window.
This section describes functions for creating a new window by
@dfn{splitting} an existing one.
@deffn Command split-window &optional window size side
@defun split-window &optional window size side
This function creates a new live window next to the window
@var{window}. If @var{window} is omitted or @code{nil}, it defaults
to the selected window. That window is ``split'', and reduced in
@ -767,7 +767,7 @@ called with the arguments @var{window}, @var{size}, and @var{side}, in
lieu of the usual action of @code{split-window}. Otherwise, this
function obeys the @code{window-atom} or @code{window-side} window
parameter, if any. @xref{Window Parameters}.
@end deffn
@end defun
As an example, here is a sequence of @code{split-window} calls that
yields the window configuration discussed in @ref{Windows and Frames}.

16
etc/ChangeLog
View file

@ -1,3 +1,19 @@
2013-04-13 Stephen Berman <stephen.berman@gmx.net>
* NEWS: Mention fixing `split-window' to be non-interactive.
2013-04-09 Tassilo Horn <tsdh@gnu.org>
* themes/tsdh-dark-theme.el (tsdh-dark): Add some more faces.
2013-04-09 Masatake YAMATO <yamato@redhat.com>
* NEWS: Mention `sh-mode' own `add-log-current-defun-function'.
2013-04-07 Jan Djärv <jan.h.d@swipnet.se>
* PROBLEMS: Mention Ubuntu warnings about libdbusmenu.
2013-04-02 Fabrice Niessen <fni@missioncriticalit.com>
* themes/leuven-theme.el: Update theme.

12
etc/NEWS
View file

@ -76,6 +76,11 @@ of the buffer is visible).
* Editing Changes in Emacs 24.4
** `split-window' is no longer a command, just a non-interactive function.
As a command it was a special case of `split-window-below', and as such
superfluous. After being reimplemented in Lisp, its interactive form
was mistakenly retained.
** New commands `toggle-frame-fullscreen' and `toggle-frame-maximized',
bound to <f11> and M-<f10>, respectively.
@ -84,9 +89,16 @@ Eg View mode, etc.
** New command `kmacro-to-register' to store keyboard macros in registers.
** Shell Script mode
*** `sh-mode' now has the mode own `add-log-current-defun-function'.
You can pick the name of the function and the variables with `C-x 4 a'.
* Changes in Specialized Modes and Packages in Emacs 24.4
** `ido-decorations' has been slightly extended to give a bit more control.
** More packages look for ~/.emacs.d/<foo> additionally to ~/.<foo>.
Affected files:
~/.emacs.d/timelog replaces ~/.timelog

17
etc/PROBLEMS
View file

@ -1405,6 +1405,23 @@ For example, in the Xfce 4.8 desktop environment, the clipboard
manager in versions of xfce4-settings-helper before 4.8.2 is buggy;
https://bugzilla.xfce.org/show_bug.cgi?id=7588 .
*** Warning messages when running in Ubuntu
When you start Emacs you may see something like this:
(emacs:2286): LIBDBUSMENU-GTK-CRITICAL **: watch_submenu: assertion
`GTK_IS_MENU_SHELL(menu)' failed
This happens if the Emacs binary has been renamed. The cause is the Ubuntu
appmenu concept. It tries to track Emacs menus and show them in the top
panel, instead of in each Emacs window. This is not properly implemented,
so it fails for Emacs. The order of menus is wrong, and things like copy/paste
that depend on what state Emacs is in are usually wrong (i.e. paste disabled
even if you should be able to paste, and similar).
You can get back menus on each frame by starting emacs like this:
% env UBUNTU_MENUPROXY= emacs
* Runtime problems on character terminals
** The meta key does not work on xterm.

3
etc/themes/tsdh-dark-theme.el
View file

@ -64,7 +64,10 @@ Used and created by Tassilo Horn.")
'(highlight ((t (:background "sea green"))))
'(hl-line ((t (:background "grey25"))))
'(hl-paren-face ((t (:weight bold))) t)
'(icomplete-first-match ((t (:foreground "deep sky blue" :weight bold))))
'(lusty-file-face ((t (:foreground "SpringGreen1"))) t)
'(magit-header ((t (:box 1 :weight bold))))
'(magit-section-title ((t (:inherit magit-header :background "dark slate blue"))))
'(menu ((t (:background "gray30" :foreground "gray70"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
'(mode-line ((t (:box (:line-width 1 :color "red") :family "DejaVu Sans"))))

2
lib/Makefile.am
View file

@ -4,7 +4,7 @@ MOSTLYCLEANDIRS =
MOSTLYCLEANFILES =
noinst_LIBRARIES =
AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
AM_CFLAGS = $(PROFILING_CFLAGS) $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src
if BUILDING_FOR_WINDOWSNT

144
lisp/ChangeLog
View file

@ -1,3 +1,147 @@
2013-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
* files.el (normal-mode): Only use default major-mode if no other mode
was specified.
* emacs-lisp/trace.el (trace-values): New function.
* files.el: Allow : in local variables (bug#14089).
(hack-local-variable-regexp): New var.
(hack-local-variables-prop-line, hack-local-variables): Use it.
2013-04-13 Roland Winkler <winkler@gnu.org>
* textmodes/bibtex.el (bibtex-search-entries): Bug fix. Use match
data before it gets modified by bibtex-beginning-of-entry.
2013-04-13 Roland Winkler <winkler@gnu.org>
* textmodes/bibtex.el (bibtex-url): Doc fix.
2013-04-13 Roland Winkler <winkler@gnu.org>
* textmodes/bibtex.el (bibtex-initialize): If the current buffer
does not visit a BibTeX file, exclude it from the list of buffers
returned by bibtex-initialize.
2013-04-13 Stephen Berman <stephen.berman@gmx.net>
* window.el (split-window): Remove interactive form, since as a
command this function is a special case of split-window-below.
Correct doc string.
2013-04-12 Roland Winkler <winkler@gnu.org>
* faces.el (read-face-name): Do not override value of arg default.
Allow single faces and strings as default values. Remove those
elements from return value that are not faces.
(describe-face): Simplify.
(face-at-point): New optional args thing and multiple so that this
function can provide the same functionality previously provided by
read-face-name.
(make-face-bold, make-face-unbold, make-face-italic)
(make-face-unitalic, make-face-bold-italic, invert-face)
(modify-face, read-face-and-attribute): Use face-at-point.
* cus-edit.el (customize-face, customize-face-other-window)
* cus-theme.el (custom-theme-add-face)
* face-remap.el (buffer-face-set)
* facemenu.el (facemenu-set-face): Use face-at-point.
2013-04-12 Michael Albinus <michael.albinus@gmx.de>
* info.el (Info-file-list-for-emacs): Add "tramp" and "dbus".
2013-04-10 Tassilo Horn <tsdh@gnu.org>
* textmodes/reftex-cite.el (reftex-parse-bibtex-entry): Don't cut
off leading { and trailing } from field values.
2013-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/timer.el (timer--check): New function.
(timer--time, timer-set-function, timer-event-handler): Use it.
(timer-set-idle-time): Simplify.
(timer--activate): CSE.
(timer-event-handler): Give more info in error message.
(internal-timer-start-idle): New function, moved from C.
* mpc.el (mpc-proc): Add `restart' argument.
(mpc-proc-cmd): Use it.
(mpc--status-timer-run): Also catch signals from `mpc-proc'.
(mpc-status-buffer-show, mpc-tagbrowser-dir-toggle): Call `mpc-proc'
less often.
2013-04-10 Masatake YAMATO <yamato@redhat.com>
* progmodes/sh-script.el: Implement `sh-mode' own
`add-log-current-defun-function' (bug#14112).
(sh-current-defun-name): New function.
(sh-mode): Use the function.
2013-04-09 Bastien Guerry <bzg@gnu.org>
* simple.el (choose-completion-string): Fix docstring (bug#14163).
2013-04-08 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/edebug.el (edebug-mode): Fix typo (bug#14144).
* emacs-lisp/timer.el (timer-event-handler): Don't retrigger a canceled
timer (bug#14156).
2013-04-07 Nic Ferrier <nferrier@ferrier.me.uk>
* emacs-lisp/ert.el (should, should-not, should-error): Add edebug
declaration.
2013-04-07 Leo Liu <sdl.web@gmail.com>
* pcmpl-x.el: New file.
2013-04-06 Dmitry Antipov <dmantipov@yandex.ru>
Do not set x-display-name until X connection is established.
This is needed to prevent from weird situation described at
<http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00212.html>.
* frame.el (make-frame): Set x-display-name after call to
window system initialization function, not before.
* term/x-win.el (x-initialize-window-system): Add optional
display argument and use it.
* term/w32-win.el (w32-initialize-window-system):
* term/ns-win.el (ns-initialize-window-system):
* term/pc-win.el (msdos-initialize-window-system):
Add compatible optional display argument.
2013-04-06 Eli Zaretskii <eliz@gnu.org>
* files.el (normal-backup-enable-predicate): On MS-Windows and
MS-DOS compare truenames of temporary-file-directory and of the
file, so that 8+3 aliases (usually found in $TEMP on Windows)
don't fail comparison by compare-strings. Also, compare file
names case-insensitively on MS-Windows and MS-DOS.
2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/package.el (package-compute-transaction): Fix last fix.
Suggested by Donald Curtis <dcurtis@coe.edu> (bug#14082).
2013-04-05 Dmitry Gutov <dgutov@yandex.ru>
* whitespace.el (whitespace-color-on, whitespace-color-off):
Only call `font-lock-fontify-buffer' when `font-lock-mode' is on.
2013-04-05 Jacek Chrząszcz <chrzaszcz@mimuw.edu.pl> (tiny change)
* ispell.el (ispell-set-spellchecker-params):
Really set `ispell-args' for all equivs.
2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca>
* ido.el (ido-completions): Use extra elements of ido-decorations
(bug#14143).
(ido-decorations): Update docstring.
2013-04-05 Michael Albinus <michael.albinus@gmx.de>
* autorevert.el (auto-revert-mode, auto-revert-tail-mode)

6
lisp/cus-edit.el
View file

@ -1319,7 +1319,8 @@ If OTHER-WINDOW is non-nil, display in another window.
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
(interactive (list (read-face-name "Customize face" "all faces" t)))
(interactive (list (read-face-name "Customize face"
(or (face-at-point t t) "all faces") t)))
(if (member face '(nil ""))
(setq face (face-list)))
(if (and (listp face) (null (cdr face)))
@ -1350,7 +1351,8 @@ If FACE is actually a face-alias, customize the face it is aliased to.
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
(interactive (list (read-face-name "Customize face" "all faces" t)))
(interactive (list (read-face-name "Customize face"
(or (face-at-point t t) "all faces") t)))
(customize-face face t))
(defalias 'customize-customized 'customize-unsaved)

2
lisp/cus-theme.el
View file

@ -263,7 +263,7 @@ interactively, this defaults to the current value of VAR."
(defun custom-theme-add-face (face &optional spec)
"Add a widget for FACE (a symbol) to the *New Custom Theme* buffer.
SPEC, if non-nil, should be a face spec to which to set the widget."
(interactive (list (read-face-name "Face name" nil nil) nil))
(interactive (list (read-face-name "Face name" (face-at-point t))))
(unless (or (facep face) spec)
(error "`%s' has no face definition" face))
(let ((entry (assq face custom-theme-faces)))

2
lisp/emacs-lisp/edebug.el
View file

@ -3814,7 +3814,7 @@ Options:
(remove-hook 'kill-buffer-hook 'edebug-kill-buffer t))
(pcase-dolist (`(,var . ,val) '((buffer-read-only . t)))
(push
(if (local-variable-p var) var (cons var (symbol-value var)))
(if (local-variable-p var) (cons var (symbol-value var)) var)
edebug--mode-saved-vars)
(set (make-local-variable var) val))
;; Append `edebug-kill-buffer' to the hook to avoid interfering with

3
lisp/emacs-lisp/ert.el
View file

@ -464,6 +464,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM."
"Evaluate FORM. If it returns nil, abort the current test as failed.
Returns the value of FORM."
(declare (debug t))
(ert--expand-should `(should ,form) form
(lambda (inner-form form-description-form _value-var)
`(unless ,inner-form
@ -473,6 +474,7 @@ Returns the value of FORM."
"Evaluate FORM. If it returns non-nil, abort the current test as failed.
Returns nil."
(declare (debug t))
(ert--expand-should `(should-not ,form) form
(lambda (inner-form form-description-form _value-var)
`(unless (not ,inner-form)
@ -520,6 +522,7 @@ non-nil, the error matches TYPE if it is an element of TYPE.
If the error matches, returns (ERROR-SYMBOL . DATA) from the
error. If not, or if no error was signaled, abort the test as
failed."
(declare (debug t))
(unless type (setq type ''error))
(ert--expand-should
`(should-error ,form ,@keys)

8
lisp/emacs-lisp/package.el
View file

@ -809,12 +809,8 @@ but version %s required"
"Need package `%s-%s', but only %s is available"
(symbol-name next-pkg) (package-version-join next-version)
(package-version-join (package-desc-vers (cdr pkg-desc)))))
;; Only add to the transaction if we don't already have it.
(unless (memq next-pkg package-list)
(setq package-list
;; Move to front, so it gets installed early enough
;; (bug#14082).
(cons next-pkg (delq next-pkg package-list))))
;; Move to front, so it gets installed early enough (bug#14082).
(setq package-list (cons next-pkg (delq next-pkg package-list)))
(setq package-list
(package-compute-transaction package-list
(package-desc-reqs

147
lisp/emacs-lisp/timer.el
View file

@ -27,27 +27,34 @@
;;; Code:
;; Layout of a timer vector:
;; [triggered-p high-seconds low-seconds usecs repeat-delay
;; function args idle-delay psecs]
;; triggered-p is nil if the timer is active (waiting to be triggered),
;; t if it is inactive ("already triggered", in theory)
(eval-when-compile (require 'cl-lib))
(cl-defstruct (timer
(:constructor nil)
(:copier nil)
(:constructor timer-create ())
(:type vector)
(:conc-name timer--))
(:constructor nil)
(:copier nil)
(:constructor timer-create ())
(:type vector)
(:conc-name timer--))
;; nil if the timer is active (waiting to be triggered),
;; non-nil if it is inactive ("already triggered", in theory).
(triggered t)
high-seconds low-seconds usecs repeat-delay function args idle-delay psecs)
;; Time of next trigger: for normal timers, absolute time, for idle timers,
;; time relative to idle-start.
high-seconds low-seconds usecs
;; For normal timers, time between repetitions, or nil. For idle timers,
;; non-nil iff repeated.
repeat-delay
function args ;What to do when triggered.
idle-delay ;If non-nil, this is an idle-timer.
psecs)
(defun timerp (object)
"Return t if OBJECT is a timer."
(and (vectorp object) (= (length object) 9)))
(defsubst timer--check (timer)
(or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
;; Pseudo field `time'.
(defun timer--time (timer)
(list (timer--high-seconds timer)
@ -57,17 +64,17 @@
(gv-define-simple-setter timer--time
(lambda (timer time)
(or (timerp timer) (error "Invalid timer"))
(timer--check timer)
(setf (timer--high-seconds timer) (pop time))
(let ((low time) (usecs 0) (psecs 0))
(if (consp time)
(progn
(setq low (pop time))
(if time
(progn
(setq usecs (pop time))
(if time
(setq psecs (car time)))))))
(progn
(setq low (pop time))
(if time
(progn
(setq usecs (pop time))
(if time
(setq psecs (car time)))))))
(setf (timer--low-seconds timer) low)
(setf (timer--usecs timer) usecs)
(setf (timer--psecs timer) psecs))))
@ -83,15 +90,13 @@ fire repeatedly that many seconds apart."
timer)
(defun timer-set-idle-time (timer secs &optional repeat)
;; FIXME: Merge with timer-set-time.
"Set the trigger idle time of TIMER to SECS.
SECS may be an integer, floating point number, or the internal
time format returned by, e.g., `current-idle-time'.
If optional third argument REPEAT is non-nil, make the timer
fire each time Emacs is idle for that many seconds."
(if (consp secs)
(setf (timer--time timer) secs)
(setf (timer--time timer) '(0 0 0))
(timer-inc-time timer secs))
(setf (timer--time timer) (if (consp secs) secs (seconds-to-time secs)))
(setf (timer--repeat-delay timer) repeat)
timer)
@ -156,8 +161,7 @@ fire repeatedly that many seconds apart."
(defun timer-set-function (timer function &optional args)
"Make TIMER call FUNCTION with optional ARGS when triggering."
(or (timerp timer)
(error "Invalid timer"))
(timer--check timer)
(setf (timer--function timer) function)
(setf (timer--args timer) args)
timer)
@ -181,9 +185,10 @@ fire repeatedly that many seconds apart."
(setcdr reuse-cell timers))
(setq reuse-cell (cons timer timers)))
;; Insert new timer after last which possibly means in front of queue.
(cond (last (setcdr last reuse-cell))
(idle (setq timer-idle-list reuse-cell))
(t (setq timer-list reuse-cell)))
(setf (cond (last (cdr last))
(idle timer-idle-list)
(t timer-list))
reuse-cell)
(setf (timer--triggered timer) triggered-p)
(setf (timer--idle-delay timer) idle)
nil)
@ -223,8 +228,7 @@ timer will fire right away."
(defun cancel-timer (timer)
"Remove TIMER from the list of active timers."
(or (timerp timer)
(error "Invalid timer"))
(timer--check timer)
(setq timer-list (delq timer timer-list))
(setq timer-idle-list (delq timer timer-idle-list))
nil)
@ -283,40 +287,47 @@ This function is called, by name, directly by the C code."
(setq timer-event-last-1 timer-event-last)
(setq timer-event-last timer)
(let ((inhibit-quit t))
(if (timerp timer)
(let (retrigger cell)
;; Delete from queue. Record the cons cell that was used.
(setq cell (cancel-timer-internal timer))
;; Re-schedule if requested.
(if (timer--repeat-delay timer)
(if (timer--idle-delay timer)
(timer-activate-when-idle timer nil cell)
(timer-inc-time timer (timer--repeat-delay timer) 0)
;; If real time has jumped forward,
;; perhaps because Emacs was suspended for a long time,
;; limit how many times things get repeated.
(if (and (numberp timer-max-repeats)
(< 0 (timer-until timer (current-time))))
(let ((repeats (/ (timer-until timer (current-time))
(timer--repeat-delay timer))))
(if (> repeats timer-max-repeats)
(timer-inc-time timer (* (timer--repeat-delay timer)
repeats)))))
(timer-activate timer t cell)
(setq retrigger t)))
;; Run handler.
;; We do this after rescheduling so that the handler function
;; can cancel its own timer successfully with cancel-timer.
(condition-case-unless-debug err
;; Timer functions should not change the current buffer.
;; If they do, all kinds of nasty surprises can happen,
;; and it can be hellish to track down their source.
(save-current-buffer
(apply (timer--function timer) (timer--args timer)))
(error (message "Error in timer: %S" err)))
(if retrigger
(setf (timer--triggered timer) nil)))
(error "Bogus timer event"))))
(timer--check timer)
(let ((retrigger nil)
(cell
;; Delete from queue. Record the cons cell that was used.
(cancel-timer-internal timer)))
;; Re-schedule if requested.
(if (timer--repeat-delay timer)
(if (timer--idle-delay timer)
(timer-activate-when-idle timer nil cell)
(timer-inc-time timer (timer--repeat-delay timer) 0)
;; If real time has jumped forward,
;; perhaps because Emacs was suspended for a long time,
;; limit how many times things get repeated.
(if (and (numberp timer-max-repeats)
(< 0 (timer-until timer (current-time))))
(let ((repeats (/ (timer-until timer (current-time))
(timer--repeat-delay timer))))
(if (> repeats timer-max-repeats)
(timer-inc-time timer (* (timer--repeat-delay timer)
repeats)))))
;; Place it back on the timer-list before running
;; timer--function, so it can cancel-timer itself.
(timer-activate timer t cell)
(setq retrigger t)))
;; Run handler.
(condition-case-unless-debug err
;; Timer functions should not change the current buffer.
;; If they do, all kinds of nasty surprises can happen,
;; and it can be hellish to track down their source.
(save-current-buffer
(apply (timer--function timer) (timer--args timer)))
(error (message "Error running timer%s: %S"
(if (symbolp (timer--function timer))
(format " `%s'" (timer--function timer)) "")
err)))
(when (and retrigger
;; If the timer's been canceled, don't "retrigger" it
;; since it might still be in the copy of timer-list kept
;; by keyboard.c:timer_check (bug#14156).
(memq timer timer-list))
(setf (timer--triggered timer) nil)))))
;; This function is incompatible with the one in levents.el.
(defun timeout-event-p (event)
@ -527,6 +538,12 @@ If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
secs
(if (string-match-p "\\`[0-9.]+\\'" string)
(string-to-number string)))))
(defun internal-timer-start-idle ()
"Mark all idle-time timers as once again candidates for running."
(dolist (timer timer-idle-list)
(if (timerp timer) ;; FIXME: Why test?
(setf (timer--triggered timer) nil))))
(provide 'timer)

11
lisp/emacs-lisp/trace.el
View file

@ -157,6 +157,17 @@
(defvar inhibit-trace nil
"If non-nil, all tracing is temporarily inhibited.")
;;;###autoload
(defun trace-values (&rest values)
"Helper function to get internal values.
You can call this function to add internal values in the trace buffer."
(unless inhibit-trace
(with-current-buffer trace-buffer
(goto-char (point-max))
(insert
(trace-entry-message
'trace-values trace-level values "")))))
(defun trace-entry-message (function level args context)
"Generate a string that describes that FUNCTION has been entered.
LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,

2
lisp/face-remap.el
View file

@ -378,7 +378,7 @@ one face is listed, that specifies an aggregate face, like in a
This function makes the variable `buffer-face-mode-face' buffer
local, and sets it to FACE."
(interactive (list (read-face-name "Set buffer face")))
(interactive (list (read-face-name "Set buffer face" (face-at-point t))))
(while (and (consp specs) (null (cdr specs)))
(setq specs (car specs)))
(if (null specs)

2
lisp/facemenu.el
View file

@ -329,7 +329,7 @@ This command can also add FACE to the menu of faces,
if `facemenu-listed-faces' says to do that."
(interactive (list (progn
(barf-if-buffer-read-only)
(read-face-name "Use face"))
(read-face-name "Use face" (face-at-point t)))
(if (and mark-active (not current-prefix-arg))
(region-beginning))
(if (and mark-active (not current-prefix-arg))

175
lisp/faces.el
View file

@ -757,7 +757,8 @@ is specified, `:italic' is ignored."
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font weight."
(interactive (list (read-face-name "Make which face bold")))
(interactive (list (read-face-name "Make which face bold"
(face-at-point t))))
(set-face-attribute face frame :weight 'bold))
@ -765,7 +766,8 @@ Use `set-face-attribute' for finer control of the font weight."
"Make the font of FACE be non-bold, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
(interactive (list (read-face-name "Make which face non-bold")))
(interactive (list (read-face-name "Make which face non-bold"
(face-at-point t))))
(set-face-attribute face frame :weight 'normal))
@ -774,7 +776,8 @@ Argument NOERROR is ignored and retained for compatibility."
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of the font slant."
(interactive (list (read-face-name "Make which face italic")))
(interactive (list (read-face-name "Make which face italic"
(face-at-point t))))
(set-face-attribute face frame :slant 'italic))
@ -782,7 +785,8 @@ Use `set-face-attribute' for finer control of the font slant."
"Make the font of FACE be non-italic, if possible.
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility."
(interactive (list (read-face-name "Make which face non-italic")))
(interactive (list (read-face-name "Make which face non-italic"
(face-at-point t))))
(set-face-attribute face frame :slant 'normal))
@ -791,7 +795,8 @@ Argument NOERROR is ignored and retained for compatibility."
FRAME nil or not specified means change face on all frames.
Argument NOERROR is ignored and retained for compatibility.
Use `set-face-attribute' for finer control of font weight and slant."
(interactive (list (read-face-name "Make which face bold-italic")))
(interactive (list (read-face-name "Make which face bold-italic"
(face-at-point t))))
(set-face-attribute face frame :weight 'bold :slant 'italic))
@ -911,7 +916,7 @@ If FRAME is omitted or nil, it means change face on all frames.
If FACE specifies neither foreground nor background color,
set its foreground and background to the background and foreground
of the default face. Value is FACE."
(interactive (list (read-face-name "Invert face")))
(interactive (list (read-face-name "Invert face" (face-at-point t))))
(let ((fg (face-attribute face :foreground frame))
(bg (face-attribute face :background frame)))
(if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
@ -929,85 +934,54 @@ of the default face. Value is FACE."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun read-face-name (prompt &optional default multiple)
"Read one or more face names, defaulting to the face(s) at point.
PROMPT should be a prompt string; it should not end in a space or
a colon.
"Read one or more face names, prompting with PROMPT.
PROMPT should not end in a space or a colon.
The optional argument DEFAULT specifies the default face name(s)
to return if the user just types RET. If its value is non-nil,
it should be a list of face names (symbols or strings); in that case,
the default return value is the `car' of DEFAULT (if the argument
MULTIPLE is non-nil), or DEFAULT (if MULTIPLE is nil). See below
for the meaning of MULTIPLE.
If DEFAULT is nil, the list of default face names is taken from
the symbol at point and the `read-face-name' property of the text at point,
or, if that is nil, from the `face' property of the text at point.
Return DEFAULT if the user enters the empty string.
If DEFAULT is non-nil, it should be a list of face names (symbols or strings).
In that case, return the `car' of DEFAULT (if MULTIPLE is non-nil),
or DEFAULT (if MULTIPLE is nil). See below for the meaning of MULTIPLE.
DEFAULT can also be a single face.
This function uses `completing-read-multiple' with \"[ \\t]*,[ \\t]*\"
as the separator regexp. Thus, the user may enter multiple face
names, separated by commas. The optional argument MULTIPLE
specifies the form of the return value. If MULTIPLE is non-nil,
return a list of face names; if the user entered just one face
name, the return value would be a list of one face name.
Otherwise, return a single face name; if the user entered more
than one face name, return only the first one."
;; Should we better not generate automagically a value for DEFAULT
;; when `read-face-name' was called with DEFAULT being nil?
;; Such magic is somewhat unusual for a function `read-...'.
;; Also, one cannot skip this magic by means of a suitable
;; value of DEFAULT. It would be cleaner to use
;; (read-face-name prompt (face-at-point)).
(unless default
;; Try to get a default face name from the buffer.
(let ((thing (intern-soft (thing-at-point 'symbol))))
(if (memq thing (face-list))
(setq default (list thing))))
;; Add the named faces that the `read-face-name' or `face' property uses.
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face))))
(if (and (listp faceprop)
;; Don't treat an attribute spec as a list of faces.
(not (keywordp (car faceprop)))
(not (memq (car faceprop) '(foreground-color background-color))))
(dolist (face faceprop)
(if (symbolp face)
(push face default)))
(if (symbolp faceprop)
(push faceprop default)))
(delete-dups default)))
as the separator regexp. Thus, the user may enter multiple face names,
separated by commas.
;; If we only want one, and the default is more than one,
;; discard the unwanted ones now.
(if (and default (not multiple))
(setq default (list (car default))))
MULTIPLE specifies the form of the return value. If MULTIPLE is non-nil,
return a list of face names; if the user entered just one face name,
return a list of one face name. Otherwise, return a single face name;
if the user entered more than one face name, return only the first one."
(if (and default (not (stringp default)))
(setq default
(cond ((symbolp default)
(symbol-name default))
(multiple
(mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
default ", "))
;; If we only want one, and the default is more than one,
;; discard the unwanted ones.
(t (symbol-name (car default))))))
(if default
(setq default (mapconcat (lambda (f)
(if (symbolp f) (symbol-name f) f))
default ", ")))
;; Build up the completion tables.
(let (aliasfaces nonaliasfaces)
(let (aliasfaces nonaliasfaces faces)
;; Build up the completion tables.
(mapatoms (lambda (s)
(if (custom-facep s)
(if (facep s)
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
(let ((faces
;; Read the faces.
(mapcar 'intern
(completing-read-multiple
(if default
(format "%s (default `%s'): " prompt default)
(format "%s: " prompt))
(completion-table-in-turn nonaliasfaces aliasfaces)
nil t nil 'face-name-history default))))
;; Return either a list of faces or just one face.
(if multiple
faces
(car faces)))))
(dolist (face (completing-read-multiple
(if default
(format "%s (default `%s'): " prompt default)
(format "%s: " prompt))
(completion-table-in-turn nonaliasfaces aliasfaces)
nil t nil 'face-name-history default))
;; Ignore elements that are not faces
;; (for example, because DEFAULT was "all faces")
(if (facep face) (push (intern face) faces)))
;; Return either a list of faces or just one face.
(if multiple
(nreverse faces)
(last faces))))
;; Not defined without X, but behind window-system test.
(defvar x-bitmap-file-path)
@ -1235,7 +1209,7 @@ and the face and its settings are obtained by querying the user."
:slant (if italic-p 'italic 'normal)
:underline underline
:inverse-video inverse-p)
(setq face (read-face-name "Modify face"))
(setq face (read-face-name "Modify face" (face-at-point t)))
(apply #'set-face-attribute face frame
(read-all-face-attributes face frame))))
@ -1247,13 +1221,13 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read
\(a symbol), and NEW-VALUE is value read."
(cond ((eq attribute :font)
(let* ((prompt "Set font-related attributes of face")
(face (read-face-name prompt))
(face (read-face-name prompt (face-at-point t)))
(font (read-face-font face frame)))
(list face font)))
(t
(let* ((attribute-name (face-descriptive-attribute-name attribute))
(prompt (format "Set %s of face" attribute-name))
(face (read-face-name prompt))
(face (read-face-name prompt (face-at-point t)))
(new-value (read-face-attribute face attribute frame)))
(list face new-value)))))
@ -1363,8 +1337,7 @@ If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame."
(interactive (list (read-face-name "Describe face"
(if (eq 'default (face-at-point))
'(default))
(or (face-at-point t) 'default)
t)))
(let* ((attrs '((:family . "Family")
(:foundry . "Foundry")
@ -1879,23 +1852,33 @@ resulting color name in the echo area."
(when msg (message "Color: `%s'" color))
color))
(defun face-at-point ()
(defun face-at-point (&optional thing multiple)
"Return the face of the character after point.
If it has more than one face, return the first one.
Return nil if it has no specified face."
(let* ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)
'default))
(face (cond ((symbolp faceprop) faceprop)
;; List of faces (don't treat an attribute spec).
;; Just use the first face.
((and (consp faceprop) (not (keywordp (car faceprop)))
(not (memq (car faceprop)
'(foreground-color background-color))))
(car faceprop))
(t nil)))) ; Invalid face value.
(if (facep face) face nil)))
If THING is non-nil try first to get a face name from the buffer.
IF MULTIPLE is non-nil, return a list of all faces.
Return nil if there is no face."
(let (faces)
(if thing
;; Try to get a face name from the buffer.
(let ((face (intern-soft (thing-at-point 'symbol))))
(if (facep face)
(push face faces))))
;; Add the named faces that the `read-face-name' or `face' property uses.
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face))))
(cond ((facep faceprop)
(push faceprop faces))
((and (listp faceprop)
;; Don't treat an attribute spec as a list of faces.
(not (keywordp (car faceprop)))
(not (memq (car faceprop)
'(foreground-color background-color))))
(dolist (face faceprop)
(if (facep face)
(push face faces))))))
(setq faces (delete-dups (nreverse faces)))
(if multiple faces (car faces))))
(defun foreground-color-at-point ()
"Return the foreground color of the character after point."

89
lisp/files.el
View file

@ -1986,8 +1986,7 @@ Do you want to revisit the file normally now? ")
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'no-conversion)
(set-buffer-major-mode buf)
(make-local-variable 'find-file-literally)
(setq find-file-literally t))
(setq-local find-file-literally t))
(after-find-file error (not nowarn)))
(current-buffer))))
@ -2175,7 +2174,7 @@ not set local variables (though we do notice a mode specified with -*-.)
or from Lisp without specifying the optional argument FIND-FILE;
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
(funcall (or (default-value 'major-mode) 'fundamental-mode))
(fundamental-mode)
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
;; FIXME this is less efficient than it could be, since both
;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
@ -2759,7 +2758,9 @@ we don't actually set it to the same mode the buffer already has."
(if (functionp re)
(funcall re)
(looking-at re)))))))
(set-auto-mode-0 done keep-mode-if-same)))))
(set-auto-mode-0 done keep-mode-if-same)))
(unless done
(set-buffer-major-mode (current-buffer)))))
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
@ -3029,6 +3030,9 @@ n -- to ignore the local variables list.")
(prog1 (memq char '(?! ?\s ?y))
(quit-window t)))))))
(defconst hack-local-variable-regexp
"[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*")
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
Returns an alist of elements (VAR . VAL), where VAR is a variable
@ -3055,11 +3059,11 @@ mode, if there is one, otherwise nil."
;; (last ";" is optional).
;; If MODE-ONLY, just check for `mode'.
;; Otherwise, parse the -*- line into the RESULT alist.
(while (and (or (not mode-only)
(not result))
(< (point) end))
(unless (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
(message "Malformed mode-line")
(while (not (or (and mode-only result)
(>= (point) end)))
(unless (looking-at hack-local-variable-regexp)
(message "Malformed mode-line: %S"
(buffer-substring-no-properties (point) end))
(throw 'malformed-line nil))
(goto-char (match-end 0))
;; There used to be a downcase here,
@ -3211,8 +3215,7 @@ local variables, but directory-local variables may still be applied."
(prefix
(concat "^" (regexp-quote
(buffer-substring (line-beginning-position)
(match-beginning 0)))))
beg)
(match-beginning 0))))))
(forward-line 1)
(let ((startpos (point))
@ -3247,18 +3250,16 @@ local variables, but directory-local variables may still be applied."
(forward-line 1))
(goto-char (point-min))
(while (and (not (eobp))
(or (not mode-only)
(not result)))
;; Find the variable name; strip whitespace.
(skip-chars-forward " \t")
(setq beg (point))
(skip-chars-forward "^:\n")
(if (eolp) (error "Missing colon in local variables entry"))
(skip-chars-backward " \t")
(let* ((str (buffer-substring beg (point)))
(var (let ((read-circle nil))
(read str)))
(while (not (or (eobp)
(and mode-only result)))
;; Find the variable name;
(unless (looking-at hack-local-variable-regexp)
(error "Malformed local variable line: %S"
(buffer-substring-no-properties
(point) (line-end-position))))
(goto-char (match-end 1))
(let* ((str (match-string 1))
(var (intern str))
val val2)
(and (equal (downcase (symbol-name var)) "mode")
(setq var 'mode))
@ -4180,23 +4181,31 @@ ignored."
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory',
`small-temporary-file-directory', and /tmp."
(not (or (let ((comp (compare-strings temporary-file-directory 0 nil
name 0 nil)))
;; Directory is under temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length temporary-file-directory)))))
(let ((comp (compare-strings "/tmp" 0 nil
name 0 nil)))
;; Directory is under /tmp.
(and (not (eq comp t))
(< comp (- (length "/tmp")))))
(if small-temporary-file-directory
(let ((comp (compare-strings small-temporary-file-directory
0 nil
name 0 nil)))
;; Directory is under small-temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length small-temporary-file-directory)))))))))
(let ((temporary-file-directory temporary-file-directory)
caseless)
;; On MS-Windows, file-truename will convert short 8+3 alises to
;; their long file-name equivalents, so compare-strings does TRT.
(if (memq system-type '(ms-dos windows-nt))
(setq temporary-file-directory (file-truename temporary-file-directory)
name (file-truename name)
caseless t))
(not (or (let ((comp (compare-strings temporary-file-directory 0 nil
name 0 nil caseless)))
;; Directory is under temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length temporary-file-directory)))))
(let ((comp (compare-strings "/tmp" 0 nil
name 0 nil)))
;; Directory is under /tmp.
(and (not (eq comp t))
(< comp (- (length "/tmp")))))
(if small-temporary-file-directory
(let ((comp (compare-strings small-temporary-file-directory
0 nil
name 0 nil caseless)))
;; Directory is under small-temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length small-temporary-file-directory))))))))))
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.

5
lisp/frame.el
View file

@ -655,9 +655,8 @@ the new frame according to its own rules."
(error "Don't know how to create a frame on window system %s" w))
(unless (get w 'window-system-initialized)
(unless x-display-name
(setq x-display-name display))
(funcall (cdr (assq w window-system-initialization-alist)))
(funcall (cdr (assq w window-system-initialization-alist)) display)
(setq x-display-name display)
(put w 'window-system-initialized t))
;; Add parameters from `window-system-default-frame-alist'.

17
lisp/gnus/ChangeLog
View file

@ -1,3 +1,20 @@
2013-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-msg.el (gnus-msg-mail): Make it avoid using posting styles
corresponding to any existing group (Bug#14166).
2013-04-10 Andrew Cohen <cohen@bu.edu>
* nnir.el (number-sequence): No longer used.
(nnir-request-set-mark): New function.
(nnir-request-update-info): Improve marks updating.
(nnir-request-scan): Don't duplicate marks updating.
(gnus-group-make-nnir-group, nnir-run-imap, nnir-request-create-group):
Use 'assq rather than 'assoc. Quote anonymous function.
(nnir-request-group, nnir-close-group, gnus-summary-create-nnir-group):
Use 'gnus-group-prefixed-p.
(gnus-summary-create-nnir-group): Make sure server for method is open.
2013-04-04 Andrew Cohen <cohen@bu.edu>
* nnir.el (gnus-nnir-group-p): New function.

3
lisp/gnus/gnus-msg.el
View file

@ -538,7 +538,8 @@ instead."
(message-mail to subject other-headers continue
nil yank-action send-actions return-action))
(let ((buf (current-buffer))
(gnus-newsgroup-name (or gnus-newsgroup-name ""))
;; Don't use posting styles corresponding to any existing group.
(gnus-newsgroup-name "")
mail-buf)
(gnus-setup-message 'message
(message-mail to subject other-headers continue

109
lisp/gnus/nnir.el
View file

@ -173,15 +173,7 @@
;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(unless (fboundp 'number-sequence)
(defun number-sequence (from to)
(let (seq (n 0) (next from))
(while (<= next to)
(setq seq (cons next seq)
n (1+ n)
next (+ from n )))
(nreverse seq)))))
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(require 'nnoo)
(require 'gnus-group)
@ -610,7 +602,7 @@ an alist with `nnir-query-spec' and `nnir-group-spec' keys, and
skips all prompting."
(interactive "P")
(let* ((group-spec
(or (cdr (assoc 'nnir-group-spec specs))
(or (cdr (assq 'nnir-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(nnir-categorize
@ -620,7 +612,7 @@ skips all prompting."
(cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
gnus-group-server))))
(query-spec
(or (cdr (assoc 'nnir-query-spec specs))
(or (cdr (assq 'nnir-query-spec specs))
(apply
'append
(list (cons 'query
@ -667,9 +659,7 @@ skips all prompting."
(deffoo nnir-request-group (group &optional server dont-check info)
(nnir-possibly-change-group group server)
(let ((pgroup (if (gnus-group-prefixed-p group)
group
(gnus-group-prefixed-name group '(nnir "nnir"))))
(let ((pgroup (gnus-group-guess-full-name-from-command-method group))
length)
;; Check for cached search result or run the query and cache the
;; result.
@ -846,11 +836,31 @@ skips all prompting."
(artnumber (nnir-article-number article)))
(gnus-request-update-mark artgroup artnumber mark)))
(deffoo nnir-request-set-mark (group actions &optional server)
(let (mlist)
(dolist (action actions)
(destructuring-bind (range action marks) action
(let ((articles-by-group (nnir-categorize
(gnus-uncompress-range range)
nnir-article-group nnir-article-number)))
(dolist (artgroup articles-by-group)
(push (list
(car artgroup)
(list (gnus-compress-sequence
(sort (cadr artgroup) '<)) action marks)) mlist)))))
(dolist (request (nnir-categorize mlist car cadr))
(gnus-request-set-mark (car request) (cadr request)))))
(deffoo nnir-request-update-info (group info &optional server)
(let ((articles-by-group
(nnir-possibly-change-group group)
;; clear out all existing marks.
(gnus-info-set-marks info nil)
(gnus-info-set-read info nil)
(let ((group (gnus-group-guess-full-name-from-command-method group))
(articles-by-group
(nnir-categorize
(number-sequence 1 (nnir-artlist-length nnir-artlist))
(gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist)))
nnir-article-group nnir-article-ids)))
(gnus-set-active group
(cons 1 (nnir-artlist-length nnir-artlist)))
@ -864,29 +874,24 @@ skips all prompting."
info
(gnus-add-to-range
(gnus-info-read info)
(remove nil (mapcar (lambda (art)
(let ((num (cdr art)))
(when (gnus-member-of-range num read)
(car art)))) articleids))))
(mapc (lambda (mark)
(let ((type (car mark))
(range (cdr mark)))
(gnus-add-marked-articles
group
type
(remove nil
(mapcar
(lambda (art)
(let ((num (cdr art)))
(when (gnus-member-of-range num range)
(car art))))
articleids))))) marks)))))
(delq nil
(mapcar
#'(lambda (art)
(when (gnus-member-of-range (cdr art) read) (car art)))
articleids))))
(dolist (mark marks)
(destructuring-bind (type . range) mark
(gnus-add-marked-articles
group type
(delq nil
(mapcar
#'(lambda (art)
(when (gnus-member-of-range (cdr art) range) (car art)))
articleids)))))))))
(deffoo nnir-close-group (group &optional server)
(let ((pgroup (if (gnus-group-prefixed-p group)
group
(gnus-group-prefixed-name group '(nnir "nnir")))))
(let ((pgroup (gnus-group-guess-full-name-from-command-method group)))
(when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup)))
(gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist))
(setq nnir-artlist nil)
@ -963,7 +968,7 @@ details on the language and supported extensions."
'vconcat
(catch 'found
(mapcar
(lambda (group)
#'(lambda (group)
(let (artlist)
(condition-case ()
(when (nnimap-possibly-change-group
@ -1861,12 +1866,11 @@ article came from is also searched."
(defun gnus-summary-create-nnir-group ()
(interactive)
(or (nnir-server-opened "") (nnir-open-server "nnir"))
(let ((name (gnus-read-group "Group name: "))
(method "nnir")
(pgroup (if (gnus-group-prefixed-p gnus-newsgroup-name)
gnus-newsgroup-name
(gnus-group-prefixed-name
gnus-newsgroup-name '(nnir "nnir")))))
(method '(nnir ""))
(pgroup
(gnus-group-guess-full-name-from-command-method gnus-newsgroup-name)))
(with-current-buffer gnus-group-buffer
(gnus-group-make-group
name method nil
@ -1876,20 +1880,20 @@ article came from is also searched."
(deffoo nnir-request-create-group (group &optional server args)
(message "Creating nnir group %s" group)
(let* ((group (gnus-group-prefixed-name group '(nnir "nnir")))
(specs (assoc 'nnir-specs args))
(specs (assq 'nnir-specs args))
(query-spec
(or (cdr (assoc 'nnir-query-spec specs))
(or (cdr (assq 'nnir-query-spec specs))
(list (cons 'query
(read-string "Query: " nil 'nnir-search-history)))))
(group-spec
(or (cdr (assoc 'nnir-group-spec specs))
(or (cdr (assq 'nnir-group-spec specs))
(list (list (read-string "Server: " nil nil)))))
(nnir-specs (list (cons 'nnir-query-spec query-spec)
(cons 'nnir-group-spec group-spec))))
(gnus-group-set-parameter group 'nnir-specs nnir-specs)
(gnus-group-set-parameter
group 'nnir-artlist
(or (cdr (assoc 'nnir-artlist args))
(or (cdr (assq 'nnir-artlist args))
(nnir-run-query nnir-specs)))
(nnir-request-update-info group (gnus-get-info group)))
t)
@ -1901,22 +1905,11 @@ article came from is also searched."
t)
(deffoo nnir-request-scan (group method)
(if group
(let ((pgroup (if (gnus-group-prefixed-p group)
group
(gnus-group-prefixed-name group '(nnir "nnir")))))
(gnus-group-set-parameter
pgroup 'nnir-artlist
(setq nnir-artlist
(nnir-run-query
(gnus-group-get-parameter pgroup 'nnir-specs t))))
(nnir-request-update-info pgroup (gnus-get-info pgroup)))
t))
t)
(deffoo nnir-request-close ()
t)
(nnoo-define-skeleton nnir)
;; The end.

16
lisp/ido.el
View file

@ -765,7 +765,7 @@ Obsolete. Set 3rd element of `ido-decorations' instead."
(defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]" " [Not readable]" " [Too big]" " [Confirm]")
"List of strings used by ido to display the alternatives in the minibuffer.
There are 11 elements in this list:
There are between 11 and 13 elements in this list:
1st and 2nd elements are used as brackets around the prospect list,
3rd element is the separator between prospects (ignored if `ido-separator' is set),
4th element is the string inserted at the end of a truncated list of prospects,
@ -775,7 +775,9 @@ can be completed using TAB,
8th element is displayed if there is a single match (and faces are not used),
9th element is displayed when the current directory is non-readable,
10th element is displayed when directory exceeds `ido-max-directory-size',
11th element is displayed to confirm creating new file or buffer."
11th element is displayed to confirm creating new file or buffer.
12th and 13th elements (if present) are used as brackets around the sole
remaining completion. If absent, elements 5 and 6 are used instead."
:type '(repeat string)
:group 'ido)
@ -4581,10 +4583,12 @@ For details of keybindings, see `ido-find-file'."
(string-equal (match-string 0 (ido-name (car comps)))
(ido-name (car comps))))
""
;; when there is one match, show the matching file name in full
(concat (nth 4 ido-decorations) ;; [ ... ]
(ido-name (car comps))
(nth 5 ido-decorations)))
;; When there is only one match, show the matching file
;; name in full, wrapped in [ ... ].
(concat
(or (nth 11 ido-decorations) (nth 4 ido-decorations))
(ido-name (car comps))
(or (nth 12 ido-decorations) (nth 5 ido-decorations))))
(if (not ido-use-faces) (nth 7 ido-decorations)))) ;; [Matched]
(t ;multiple matches
(let* ((items (if (> ido-max-prospects 0) (1+ ido-max-prospects) 999))

3
lisp/info.el
View file

@ -4383,7 +4383,8 @@ This feature will be removed in future.")
("ietf-drums" . "emacs-mime") ("quoted-printable" . "emacs-mime")
("binhex" . "emacs-mime") ("uudecode" . "emacs-mime")
("mailcap" . "emacs-mime") ("mm" . "emacs-mime")
("mml" . "emacs-mime"))
("mml" . "emacs-mime")
"tramp" "dbus")
"List of Info files that describe Emacs commands.
An element can be a file name, or a list of the form (PREFIX . FILE)
where PREFIX is a name prefix and FILE is the file to look in.

33
lisp/mpc.el
View file

@ -320,10 +320,11 @@ defaults to 6600 and HOST defaults to localhost."
(if tmp (push (nreverse tmp) alists))
(nreverse alists)))
(defun mpc-proc ()
(defun mpc-proc (&optional restart)
(unless (and mpc-proc
(buffer-live-p (process-buffer mpc-proc))
(not (memq (process-status mpc-proc) '(closed))))
(not (and restart
(memq (process-status mpc-proc) '(closed)))))
(mpc--proc-connect mpc-host))
mpc-proc)
@ -356,7 +357,7 @@ otherwise return immediately and call CALLBACK with no argument
when the command terminates.
CMD can be a string which is passed as-is to MPD or a list of strings
which will be concatenated with proper quoting before passing them to MPD."
(let ((proc (mpc-proc)))
(let ((proc (mpc-proc 'restart)))
(if (and callback (not (process-get proc 'ready)))
(let ((old (process-get proc 'callback)))
(process-put proc 'callback
@ -491,10 +492,10 @@ to call FUN for any change whatsoever.")
(cancel-timer mpc--status-timer)
(setq mpc--status-timer nil)))
(defun mpc--status-timer-run ()
(when (process-get (mpc-proc) 'ready)
(condition-case err
(with-local-quit (mpc-status-refresh))
(error (message "MPC: %s" err)))))
(when (process-get (mpc-proc) 'ready)
(with-local-quit (mpc-status-refresh)))
(error (message "MPC: %s" err))))
(defvar mpc--status-idle-timer nil)
(defun mpc--status-idle-timer-start ()
@ -1177,14 +1178,15 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(defun mpc-status-buffer-show ()
(interactive)
(let* ((buf (mpc-proc-buffer (mpc-proc) 'status))
(songs-buf (mpc-proc-buffer (mpc-proc) 'songs))
(let* ((proc (mpc-proc))
(buf (mpc-proc-buffer proc 'status))
(songs-buf (mpc-proc-buffer proc 'songs))
(songs-win (if songs-buf (get-buffer-window songs-buf 0))))
(unless (buffer-live-p buf)
(setq buf (get-buffer-create "*MPC-Status*"))
(with-current-buffer buf
(mpc-status-mode))
(mpc-proc-buffer (mpc-proc) 'status buf))
(mpc-proc-buffer proc 'status buf))
(if (null songs-win) (pop-to-buffer buf)
(let ((_win (split-window songs-win 20 t)))
(set-window-dedicated-p songs-win nil)
@ -1692,13 +1694,14 @@ Return non-nil if a selection was deactivated."
(mpc-event-set-point event)
(let ((name (buffer-substring (line-beginning-position)
(line-end-position)))
(prop (intern mpc-tag)))
(if (not (member name (process-get (mpc-proc) prop)))
(process-put (mpc-proc) prop
(cons name (process-get (mpc-proc) prop)))
(let ((new (delete name (process-get (mpc-proc) prop))))
(prop (intern mpc-tag))
(proc (mpc-proc)))
(if (not (member name (process-get proc prop)))
(process-put proc prop
(cons name (process-get proc prop)))
(let ((new (delete name (process-get proc prop))))
(setq name (concat name "/"))
(process-put (mpc-proc) prop
(process-put proc prop
(delq nil
(mapcar (lambda (x)
(if (string-prefix-p name x)

251
lisp/pcmpl-x.el Normal file
View file

@ -0,0 +1,251 @@
;;; pcmpl-x.el --- completion for miscellaneous tools -*- lexical-binding: t; -*-
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
;; Keywords: processes, tools, convenience
;; Package: pcomplete
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; 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/>.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'pcomplete)
;;;; tlmgr - http://www.tug.org/texlive/tlmgr.html
(defcustom pcmpl-x-tlmgr-program "tlmgr"
"Name of the tlmgr program."
:type 'file
:group 'pcomplete)
(defvar pcmpl-x-tlmgr-common-options
'("--repository"
"--gui"
"--gui-lang"
"--machine-readable"
"--package-logfile"
"--pause"
"--persistent-downloads"
"--no-persistent-downloads"
"--no-execute-actions"
"--debug-translation"
"--help"
"--version"))
(defvar pcmpl-x-tlmgr-actions
'(("help")
("version")
("gui")
("install")
("update")
("backup")
("restore")
("remove")
("repository" ("list" "add" "remove" "set"))
("candidates")
("option" ("show"
"showall"
"repository"
"formats"
"postcode"
"docfiles"
"srcfiles"
"backupdir"
"autobackup"
"sys_bin"
"sys_man"
"sys_info"
"desktop_integration"
"fileassocs"
"multiuser"))
("conf" ("texmf" "tlmgr"))
("paper"
("a4" "letter" "xdvi" "pdftex" "dvips" "dvipdfmx" "dvipdfm" "context")
(lambda ()
(unless (member (pcomplete-arg 1) '("a4" "letter"))
(pcomplete-here* '("paper"))
(pcomplete-here* '("a4" "letter")))))
("platform" ("list" "add" "remove"))
("print-platform" ("collections" "schemes"))
("arch" ("list" "add" "remove"))
("print-arch" ("collections" "schemes"))
("info" ("collections" "schemes"))
("search")
("dump-tlpdb")
("check" ("files" "depends" "executes" "runfiles" "all"))
("path" ("add" "remove"))
("postaction" ("install" "remove") ("shortcut" "fileassoc" "script"))
("uninstall")
("generate" ("language"
"language.dat"
"language.def"
"language.dat.lua"
"fmtutil"))))
(defvar pcmpl-x-tlmgr-options-cache (make-hash-table :size 31 :test 'equal))
(defun pcmpl-x-tlmgr-action-options (action)
"Get the list of long options for ACTION."
(if (eq (gethash action pcmpl-x-tlmgr-options-cache 'missing) 'missing)
(with-temp-buffer
(when (zerop
(call-process pcmpl-x-tlmgr-program nil t nil action "-h"))
(goto-char (point-min))
(puthash action
(cons "--help"
(cl-loop while (re-search-forward
"^[ \t]+\\(--[[:alnum:]-]+=?\\)"
nil t)
collect (match-string 1)))
pcmpl-x-tlmgr-options-cache)
(pcmpl-x-tlmgr-action-options action)))
(gethash action pcmpl-x-tlmgr-options-cache)))
;;;###autoload
(defun pcomplete/tlmgr ()
"Completion for the `tlmgr' command."
(while (pcomplete-match "^--" 0)
(pcomplete-here* pcmpl-x-tlmgr-common-options)
(unless (or (pcomplete-match "^--" 0)
(all-completions (pcomplete-arg 0) pcmpl-x-tlmgr-actions))
(pcomplete-here* (pcomplete-dirs-or-entries))))
(pcomplete-here* pcmpl-x-tlmgr-actions)
(let ((action (substring-no-properties (pcomplete-arg 1))))
(while t
(if (pcomplete-match "^--" 0)
(pcomplete-here* (pcmpl-x-tlmgr-action-options action))
(dolist (completions (cdr (assoc action pcmpl-x-tlmgr-actions)))
(cond ((functionp completions)
(funcall completions))
((all-completions (pcomplete-arg 0) completions)
(pcomplete-here* completions))
(t (pcomplete-here* (pcomplete-dirs-or-entries)))))
(unless (pcomplete-match "^--" 0)
(pcomplete-here* (pcomplete-dirs-or-entries)))))))
;;;; ack - http://betterthangrep.com
;; Usage:
;; - To complete short options type '-' first
;; - To complete long options type '--' first
;; - Color name completion is supported following
;; --color-filename=, --color-match= and --color-lineno=
;; - Type completion is supported following --type=
(defcustom pcmpl-x-ack-program
(file-name-nondirectory (or (executable-find "ack-grep")
(executable-find "ack")
"ack"))
"Name of the ack program."
:type 'file
:group 'pcomplete)
(defvar pcmpl-x-ack-color-options
'("clear"
"reset"
"dark"
"bold"
"underline"
"underscore"
"blink"
"reverse"
"concealed"
"black"
"red"
"green"
"yellow"
"blue"
"magenta"
"on_black"
"on_red"
"on_green"
"on_yellow"
"on_blue"
"on_magenta"
"on_cyan"
"on_white")
"Color names for the `ack' command.")
(defun pcmpl-x-ack-run (buffer &rest args)
"Run ack with ARGS and send the output to BUFFER."
(condition-case nil
(apply 'call-process (or pcmpl-x-ack-program "ack") nil buffer nil args)
(file-error -1)))
(defun pcmpl-x-ack-short-options ()
"Short options for the `ack' command."
(with-temp-buffer
(let (options)
(when (zerop (pcmpl-x-ack-run t "--help"))
(goto-char (point-min))
(while (re-search-forward "^ -\\([^-]\\)" nil t)
(push (match-string 1) options))
(mapconcat 'identity (nreverse options) "")))))
(defun pcmpl-x-ack-long-options (&optional arg)
"Long options for the `ack' command."
(with-temp-buffer
(let (options)
(when (zerop (pcmpl-x-ack-run t (or arg "--help")))
(goto-char (point-min))
(while (re-search-forward
"\\(?: ?\\|, \\)\\(--\\(\\[no\\]\\)?\\([[:alnum:]-]+=?\\)\\)"
nil t)
(if (not (match-string 2))
(push (match-string 1) options)
(push (concat "--" (match-string 3)) options)
(push (concat "--no" (match-string 3)) options)))
(nreverse options)))))
(defun pcmpl-x-ack-type-options ()
"A list of types for the `ack' command."
(pcmpl-x-ack-long-options "--help-types"))
;;;###autoload
(defun pcomplete/ack ()
"Completion for the `ack' command.
Start an argument with '-' to complete short options and '--' for
long options."
;; No space after =
(while t
(if (pcomplete-match "^-" 0)
(cond
((pcomplete-match "^--color-\\w+=\\(\\S-*\\)" 0)
(pcomplete-here* pcmpl-x-ack-color-options
(pcomplete-match-string 1 0) t))
((pcomplete-match "^--\\(?:no\\)?ignore-dir=\\(\\S-*\\)" 0)
(pcomplete-here* (pcomplete-dirs)
(pcomplete-match-string 1 0) t))
((pcomplete-match "^--type=\\(\\S-*\\)" 0)
(pcomplete-here* (mapcar (lambda (type-option)
(substring type-option 2))
(pcmpl-x-ack-type-options))
(pcomplete-match-string 1 0) t))
((pcomplete-match "^--" 0)
(pcomplete-here* (append (pcmpl-x-ack-long-options)
(pcmpl-x-ack-type-options))))
(t (pcomplete-opt (pcmpl-x-ack-short-options))))
(pcomplete-here* (pcomplete-dirs-or-entries)))))
;;;###autoload
(defalias 'pcomplete/ack-grep 'pcomplete/ack)
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here

23
lisp/progmodes/sh-script.el
View file

@ -353,6 +353,28 @@ See `sh-feature' and `imenu-generic-expression'."
:group 'sh-script
:version "20.4")
(defun sh-current-defun-name ()
"Find the name of function or variable at point.
For use in `add-log-current-defun-function'."
(save-excursion
(end-of-line)
(when (re-search-backward
(concat "\\(?:"
;; function FOO
;; function FOO()
"^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?"
"\\)\\|\\(?:"
;; FOO()
"^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()"
"\\)\\|\\(?:"
;; FOO=
"^\\([[:alpha:]_][[:alnum:]_]*\\)="
"\\)")
nil t)
(or (match-string-no-properties 1)
(match-string-no-properties 2)
(match-string-no-properties 3)))))
(defvar sh-shell-variables nil
"Alist of shell variable names that should be included in completion.
These are used for completion in addition to all the variables named
@ -1533,6 +1555,7 @@ with your script for an edit-interpret-debug cycle."
(setq-local skeleton-newline-indent-rigidly t)
(setq-local defun-prompt-regexp
(concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)"))
(setq-local add-log-current-defun-function #'sh-current-defun-name)
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell

4
lisp/simple.el
View file

@ -6628,7 +6628,9 @@ the default method of inserting the completion in BUFFER.")
(defun choose-completion-string (choice &optional
buffer base-position insert-function)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-POSITION, says where to insert the completion."
BASE-POSITION says where to insert the completion.
INSERT-FUNCTION says how to insert the completion and falls
back on `completion-list-insert-choice-function' when nil."
;; If BUFFER is the minibuffer, exit the minibuffer
;; unless it is reading a file name and CHOICE is a directory,

2
lisp/term/ns-win.el
View file

@ -895,7 +895,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Do the actual Nextstep Windows setup here; the above code just
;; defines functions and variables that we use now.
(defun ns-initialize-window-system ()
(defun ns-initialize-window-system (&optional display)
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
(cl-assert (not ns-initialized))

2
lisp/term/pc-win.el
View file

@ -403,7 +403,7 @@ Errors out because it is not supposed to be called, ever."
(error "terminal-init-internal called for window-system `%s'"
(window-system)))
(defun msdos-initialize-window-system ()
(defun msdos-initialize-window-system (&optional display)
"Initialization function for the `pc' \"window system\"."
(or (eq (window-system) 'pc)
(error

2
lisp/term/w32-win.el
View file

@ -246,7 +246,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function x-parse-geometry "frame.c" (string))
(defvar x-command-line-resources)
(defun w32-initialize-window-system ()
(defun w32-initialize-window-system (&optional display)
"Initialize Emacs for W32 GUI frames."
(cl-assert (not w32-initialized))

4
lisp/term/x-win.el
View file

@ -1343,7 +1343,7 @@ Request data types in the order specified by `x-select-request-type'."
(defvar x-display-name)
(defvar x-command-line-resources)
(defun x-initialize-window-system ()
(defun x-initialize-window-system (&optional display)
"Initialize Emacs for X frames and open the first connection to an X server."
(cl-assert (not x-initialized))
@ -1357,7 +1357,7 @@ Request data types in the order specified by `x-select-request-type'."
(while (setq i (string-match "[.*]" x-resource-name))
(aset x-resource-name i ?-))))
(x-open-connection (or x-display-name
(x-open-connection (or display
(setq x-display-name (or (getenv "DISPLAY" (selected-frame))
(getenv "DISPLAY"))))
x-command-line-resources

51
lisp/textmodes/bibtex.el
View file

@ -3020,11 +3020,14 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'."
Visit the BibTeX files defined by `bibtex-files' and return a list
of corresponding buffers.
Initialize in these buffers `bibtex-reference-keys' if not yet set.
List of BibTeX buffers includes current buffer if CURRENT is non-nil.
List of BibTeX buffers includes current buffer if CURRENT is non-nil
and the current buffer visits a file using `bibtex-mode'.
If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if
already set. If SELECT is non-nil interactively select a BibTeX buffer.
When called interactively, FORCE is t, CURRENT is t if current buffer uses
`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode',"
When called interactively, FORCE is t, CURRENT is t if current buffer
visits a file using `bibtex-mode', and SELECT is t if current buffer
does not use `bibtex-mode',"
(interactive (list (eq major-mode 'bibtex-mode) t
(not (eq major-mode 'bibtex-mode))))
(let ((file-path (split-string (or bibtex-file-path default-directory) ":+"))
@ -3062,10 +3065,12 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses
(if (file-readable-p file)
(push (find-file-noselect file) buffer-list)))
;; Include current buffer iff we want it.
;; Exclude current buffer if it doesn't use `bibtex-mode'.
;; Thus calling `bibtex-initialize' gives meaningful results for
;; any current buffer.
(unless (and current (eq major-mode 'bibtex-mode)) (setq current nil))
;; Exclude current buffer if it does not visit a file using `bibtex-mode'.
;; This way we exclude BibTeX buffers such as `bibtex-search-buffer'
;; that are not visiting a BibTeX file. Also, calling `bibtex-initialize'
;; gives meaningful results for any current buffer.
(unless (and current (eq major-mode 'bibtex-mode) buffer-file-name)
(setq current nil))
(cond ((and current (not (memq (current-buffer) buffer-list)))
(push (current-buffer) buffer-list))
((and (not current) (memq (current-buffer) buffer-list))
@ -5163,6 +5168,9 @@ Return the URL or nil if none can be generated."
(if (stringp (car scheme))
(setq fmt (pop scheme)))
(dolist (step scheme)
;; In the first STEP, if the field contains multiple
;; matches, we want the match the closest to point.
;; (if (eq step (car scheme))
(setq text (cdr (assoc-string (car step) fields-alist t)))
(if (string-match (nth 1 step) text)
(push (cond ((functionp (nth 2 step))
@ -5233,19 +5241,22 @@ where FILE is the BibTeX file of ENTRY."
(if (string= "" field)
;; Unrestricted search.
(while (re-search-forward regexp nil t)
(let ((beg (bibtex-beginning-of-entry))
(end (bibtex-end-of-entry))
key)
(if (and (<= beg (match-beginning 0))
(<= (match-end 0) end)
(save-excursion
(goto-char beg)
(and (looking-at bibtex-entry-head)
(setq key (bibtex-key-in-head))))
(not (assoc key entries)))
(push (list key file
(buffer-substring-no-properties beg end))
entries))))
(save-excursion
(let ((mbeg (match-beginning 0))
(mend (match-end 0))
(beg (bibtex-beginning-of-entry))
(end (bibtex-end-of-entry))
key)
(if (and (<= beg mbeg)
(<= mend end)
(progn
(goto-char beg)
(looking-at bibtex-entry-head))
(setq key (bibtex-key-in-head))
(not (assoc key entries)))
(push (list key file
(buffer-substring-no-properties beg end))
entries)))))
;; The following is slow. But it works reliably even in more
;; complicated cases with BibTeX string constants and crossrefed
;; entries. If you prefer speed over reliability, perform an

3
lisp/textmodes/ispell.el
View file

@ -1383,7 +1383,8 @@ aspell is used along with Emacs).")
;; Unless default dict, re-add "-d" option with the mapped value
(if dict-name
(if dict-equiv
(nconc ispell-args (list "-d" dict-equiv))
(setq ispell-args
(nconc ispell-args (list "-d" dict-equiv)))
(message
"ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping."
dict-name)

6
lisp/textmodes/reftex-cite.el
View file

@ -514,12 +514,6 @@
;; remove extra whitespace
(while (string-match "[\n\t\r]\\|[ \t][ \t]+" field)
(setq field (replace-match " " nil t field)))
;; remove leading garbage
(if (string-match (if raw "^[ \t]+" "^[ \t{]+") field)
(setq field (replace-match "" nil t field)))
;; remove trailing garbage
(if (string-match (if raw "[ \t]+$" "[ \t}]+$") field)
(setq field (replace-match "" nil t field)))
(push (cons key field) alist))))
alist))

6
lisp/whitespace.el
View file

@ -2243,7 +2243,8 @@ resultant list will be returned."
(whitespace-space-after-tab-regexp 'space)))
1 whitespace-space-after-tab t)))))
(font-lock-add-keywords nil whitespace-font-lock-keywords t)
(font-lock-fontify-buffer)))
(when font-lock-mode
(font-lock-fontify-buffer))))
(defun whitespace-color-off ()
@ -2253,7 +2254,8 @@ resultant list will be returned."
(remove-hook 'post-command-hook #'whitespace-post-command-hook t)
(remove-hook 'before-change-functions #'whitespace-buffer-changed t)
(font-lock-remove-keywords nil whitespace-font-lock-keywords)
(font-lock-fontify-buffer)))
(when font-lock-mode
(font-lock-fontify-buffer))))
(defun whitespace-trailing-regexp (limit)

3
lisp/window.el
View file

@ -3686,7 +3686,7 @@ lines or columns tall. If SIZE is negative, make the new window
absolute value can be less than `window-min-height' or
`window-min-width'; so this command can make a new window as
small as one line or two columns. SIZE defaults to half of
WINDOW's size. Interactively, SIZE is the prefix argument.
WINDOW's size.
Optional third argument SIDE nil (or `below') specifies that the
new window shall be located below WINDOW. SIDE `above' means the
@ -3718,7 +3718,6 @@ scrollbars are inherited from WINDOW. If WINDOW is an internal
window, these properties as well as the buffer displayed in the
new window are inherited from the window selected on WINDOW's
frame. The selected window is not changed by this function."
(interactive "i")
(setq window (window-normalize-window window))
(let* ((side (cond
((not side) 'below)

5
nt/ChangeLog
View file

@ -1,3 +1,8 @@
2013-04-09 Ken Brown <kbrown@cornell.edu>
* emacs.rc: Use 64-bit manifest for 64-bit Cygwin build.
(Bug#12993)
2013-04-01 Eli Zaretskii <eliz@gnu.org>
* README: A better documentation of ddeclient.exe.

2
nt/emacs.rc
View file

@ -1,6 +1,6 @@
Emacs ICON icons/emacs.ico
32649 CURSOR icons/hand.cur
#ifdef WIN64
#if defined (WIN64) || defined (__x86_64__)
1 24 "emacs-x64.manifest"
#else
1 24 "emacs-x86.manifest"

173
src/ChangeLog
View file

@ -1,3 +1,156 @@
2013-04-14 Eli Zaretskii <eliz@gnu.org>
* buffer.c (syms_of_buffer) <left-margin-width, right-margin-width>
<left-fringe-width, right-fringe-width, fringes-outside-margins>:
Mention in the doc string that setting these variables takes
effect only after a call to set-window-buffer. (Bug#14200)
2013-04-13 Eli Zaretskii <eliz@gnu.org>
* indent.c (Fvertical_motion): Don't consider display strings on
overlay strings as display strings on the buffer position we
started from. This prevents vertical cursor motion from jumping
more than one line when there's an overlay string with a display
property at end of line.
Reported by Karl Chen <Karl.Chen@quarl.org> in
http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00362.html.
2013-04-12 Stefan Monnier <monnier@iro.umontreal.ca>
* window.c (select_window): `record_buffer' even if window is
already selected (bug#14191).
2013-04-11 Eli Zaretskii <eliz@gnu.org>
* window.c (Fwindow_end): Test more flags, including the buffer's
last_overlay_modified flag, to determine whether the window's
display is really up-to-date. Prevents the function from
returning a stale value. (Bug#14170)
(Fwindow_line_height): Fix the test for up-to-date-ness of the
current matrix.
2013-04-10 Eli Zaretskii <eliz@gnu.org>
* frame.c (do_switch_frame): Mark the TTY frame we switch to as
garbaged only if it is not already the top frame on its TTY.
This prevents flickering due to constant redrawing of TTY frames when
there are GUI frames open in the same session. (Bug#13864)
2013-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
* keyboard.c (timer_start_idle): Call internal-timer-start-idle instead
of marking the idle timers directly.
2013-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuf.c (Ftest_completion): Ignore non-string/symbol keys in hash
tables (bug#14054).
2013-04-08 Stefan Monnier <monnier@iro.umontreal.ca>
* window.c (select_window): Don't record_buffer while the invariant is
temporarily broken (bug#14161).
* fns.c (Fdelq): Don't assume !NILP => CONSP.
2013-04-07 Eli Zaretskii <eliz@gnu.org>
* fileio.c (ACL_NOT_WELL_SUPPORTED): Define macro for WINDOWSNT.
2013-04-07 Romain Francoise <romain@orebokech.com>
Ignore additional platform-specific ACL errors (Bug#13702).
* fileio.c (ACL_NOT_WELL_SUPPORTED): New macro copied from gnulib.
(Fcopy_file, Fset_file_acl) [HAVE_POSIX_ACL]: Use it.
2013-03-31 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (ns_mouse_position): Use NS_FRAME_P instead of checking
f->output_data.ns.
2013-04-07 Paul Eggert <eggert@cs.ucla.edu>
Fix --enable-profiling bug introduced by 2013-02-25 change (Bug#13783).
This bug was introduced by my 2013-02-25 change that simplified
data_start configuration. Without this change, on GNU/Linux
an Emacs configured with --enable-profiling fails immediately
due to a profiler signal.
* Makefile.in: Compile with $(PROFILING_CFLAGS), but do not link
with these flags. On platforms where special flags are needed
when linking temacs, the flags are now in LD_SWITCH_SYSTEM_TEMACS.
(ALL_CFLAGS): Remove $(PROFILING_CFLAGS).
(.c.o, .m.o): Compile with $(PROFILING_CFLAGS).
2013-04-07 Dmitry Antipov <dmantipov@yandex.ru>
Get rid of some platform-specific functions examining window
system and its capabilities. This is a partial rework of the
2013-04-05 change.
* lisp.h (have_menus_p): Remove prototype. This function is
replaced with platform-independent window_system_available.
(check_window_system): Move to...
* frame.h (decode_window_system_frame, window_system_available):
...here, add new prototypes.
* frame.c (window_system_available, decode_window_system_frame):
New functions.
(check_window_system): Platform-independent now.
* xterm.h (x_in_use): Remove declaration.
(check_x_frame):
* w32term.h (check_x_frame):
* nsterm.h (check_x_frame): Remove prototypes. This function
is replaced with platform-independent decode_window_system_frame.
* msdos.c (have_menus_p): Remove.
* nsfns.m (check_window_system, have_menus_p, check_ns_frame):
Remove platform-specific functions. Use check_window_system,
decode_window_system_frame and check_ns_display_info where
appropriate. Minor style and comment tweaks.
* w32fns.c (w32_in_use, check_window_system, have_menus_p)
(check_x_frame): Likewise.
* xfns.c (x_in_use, check_window_system, have_menus_p, check_x_frame):
Likewise.
* fileio.c, fns.c, font.c, fontset.c, image.c, menu.c, nsmenu.m:
* nsselect.m, nsterm.m, w32font.c, w32menu.c, xfaces.c, xgselect.c:
* xmenu.c, xselect.c: All related users changed.
2013-04-03 Kenichi Handa <handa@gnu.org>
The following changes is to optimize the code for reading UTF-8
files.
* coding.c (check_ascii): Rename from detect_ascii. Return value
changed. Check EOL format. Do not call adjust_coding_eol_type
here.
(check_utf_8): New function.
(adjust_coding_eol_type): Do nothing if already adjusted.
(detect_coding): Compare the return value of check_ascii with
coding->src_bytes. Call adjust_coding_eol_type if necessary.
(decode_coding_gap): Optimize for valid UTF-8.
2013-03-21 Kenichi Handa <handa@gnu.org>
* coding.c (syms_of_coding): Cancel previous change.
* insdel.c (insert_from_gap): Fix previous change.
2013-04-05 Dmitry Antipov <dmantipov@yandex.ru>
Consistently use platform-specific function to detect window system.
* lisp.h (check_window_system): New prototype. This function is
going to replace check_x, check_w32 and check_ns.
(have_menus_p): Mention msdos.c in comment.
* fontset.c (check_window_system_func): Remove. Adjust all users.
* fontset.h (check_window_system_func): Remove prototype.
* nsterm.h (check_ns):
* xterm.h (check_x):
* w32term.h (check_w32): Likewise.
* menu.c (Fx_popup_menu): Use check_window_system.
* msdos.c (check_window_system): Define for MS-DOS.
* nsfns.m (check_window_system): Define for NS. Adjust all users.
* w32fns.c (check_window_system): Likewise for MS-Windows.
* xfns.c (check_window_system): Likewise for X.
* font.c, frame.c, nsmenu.m, nsselect.m, nsterm.m, w32menu.c:
* xfaces.c, xmenu.c: Use check_window_system where appropriate.
2013-04-02 Paul Eggert <eggert@cs.ucla.edu>
Prefer < to > in range checks such as 0 <= i && i < N.
@ -156,8 +309,8 @@
* xdisp.c (with_echo_area_buffer_unwind_data): Save window
start marker...
(unwind_with_echo_area_buffer): ...to restore it here. This
is needed to ensure that...
(unwind_with_echo_area_buffer): ...to restore it here.
This is needed to ensure that...
(redisplay_window): ...both window markers are valid here,
which is verified by eassert.
* editfns.c (save_excursion_save): Do not assume that
@ -307,10 +460,10 @@
* w32term.c (w32fullscreen_hook): Use FRAME_NORMAL_WIDTH,
FRAME_NORMAL_HEIGHT, and FRAME_PREV_FSMODE, instead of static
variables, to save and restore frame dimensions. Use
FRAME_NORMAL_LEFT and FRAME_NORMAL_TOP to restore frame position
after returning from a 'fullscreen' configuration. use
SendMessage instead of PostMessage to send the SC_RESTORE message,
variables, to save and restore frame dimensions.
Use FRAME_NORMAL_LEFT and FRAME_NORMAL_TOP to restore frame position
after returning from a 'fullscreen' configuration.
use SendMessage instead of PostMessage to send the SC_RESTORE message,
to avoid races between the main thread and the input thread.
* w32term.h (struct w32_output): New members normal_width,
@ -395,10 +548,10 @@
* frame.h (struct frame): Drop resx and resy because the same data is
available from window system-specific output context. Adjust users.
(default_pixels_per_inch_x, default_pixels_per_inch_y): New
functions to provide defaults when no window system available.
(default_pixels_per_inch_x, default_pixels_per_inch_y):
New functions to provide defaults when no window system available.
(FRAME_RES_X, FRAME_RES_Y): New macros.
(NUMVAL): Moved from xdisp.c.
(NUMVAL): Move from xdisp.c.
* font.c (font_pixel_size, font_find_for_lface, font_open_for_lface)
(Ffont_face_attributes, Fopen_font):
* image.c (gs_load):
@ -465,7 +618,7 @@
* coding.c (decode_coding_gap): Fix typo caught by static checking.
2013-03-15 handa <handa@gnu.org>
2013-03-15 Kenichi Handa <handa@gnu.org>
* insdel.c (insert_from_gap): New arg text_at_gap_tail.
(adjust_after_replace): Make it back to static. Delete the third

8
src/Makefile.in
View file

@ -265,7 +265,7 @@ EMACSRES = @EMACSRES@
EMACS_MANIFEST = @EMACS_MANIFEST@
## If HAVE_W32, compiler arguments for including
## the resource file in the binary.
## Cygwin: -Wl,-b -Wl,pe-i386 -Wl,emacs.res
## Cygwin: -Wl,emacs.res
## MinGW: emacs.res
W32_RES_LINK=@W32_RES_LINK@
@ -331,7 +331,7 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) $(PROFILING_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
$(LIBGNUTLS_CFLAGS) \
$(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
@ -339,10 +339,10 @@ ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
.SUFFIXES: .m
.c.o:
@$(MKDEPDIR)
$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $(PROFILING_CFLAGS) $<
.m.o:
@$(MKDEPDIR)
$(CC) -c $(CPPFLAGS) $(ALL_OBJC_CFLAGS) $<
$(CC) -c $(CPPFLAGS) $(ALL_OBJC_CFLAGS) $(PROFILING_CFLAGS) $<
## lastfile must follow all files whose initialized data areas should
## be dumped as pure by dump-emacs.

25
src/buffer.c
View file

@ -5883,29 +5883,44 @@ See also the functions `display-table-slot' and `set-display-table-slot'. */);
DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
Qintegerp,
doc: /* Width of left marginal area for display of a buffer.
A value of nil means no marginal area. */);
A value of nil means no marginal area.
Setting this variable does not take effect until a new buffer is displayed
in a window. To make the change take effect, call `set-window-buffer'. */);
DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
Qintegerp,
doc: /* Width of right marginal area for display of a buffer.
A value of nil means no marginal area. */);
A value of nil means no marginal area.
Setting this variable does not take effect until a new buffer is displayed
in a window. To make the change take effect, call `set-window-buffer'. */);
DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
Qintegerp,
doc: /* Width of this buffer's left fringe (in pixels).
A value of 0 means no left fringe is shown in this buffer's window.
A value of nil means to use the left fringe width from the window's frame. */);
A value of nil means to use the left fringe width from the window's frame.
Setting this variable does not take effect until a new buffer is displayed
in a window. To make the change take effect, call `set-window-buffer'. */);
DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
Qintegerp,
doc: /* Width of this buffer's right fringe (in pixels).
A value of 0 means no right fringe is shown in this buffer's window.
A value of nil means to use the right fringe width from the window's frame. */);
A value of nil means to use the right fringe width from the window's frame.
Setting this variable does not take effect until a new buffer is displayed
in a window. To make the change take effect, call `set-window-buffer'. */);
DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
Qnil,
doc: /* Non-nil means to display fringes outside display margins.
A value of nil means to display fringes between margins and buffer text. */);
A value of nil means to display fringes between margins and buffer text.
Setting this variable does not take effect until a new buffer is displayed
in a window. To make the change take effect, call `set-window-buffer'. */);
DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
Qintegerp,

206
src/coding.c
View file

@ -6072,17 +6072,18 @@ complement_process_encoding_system (Lisp_Object coding_system)
#define EOL_SEEN_CRLF 4
static Lisp_Object adjust_coding_eol_type (struct coding_system *coding, int eol_seen);
static Lisp_Object adjust_coding_eol_type (struct coding_system *coding,
int eol_seen);
/* Return true iff all the source bytes are ASCII.
/* Return the number of ASCII characters at the head of the source.
By side effects, set coding->head_ascii and coding->eol_seen. The
value of coding->eol_seen is "logical or" of EOL_SEEN_LF,
EOL_SEEN_CR, and EOL_SEEN_CRLF, but the value is reliable only when
all the source bytes are ASCII. */
static bool
detect_ascii (struct coding_system *coding)
static int
check_ascii (struct coding_system *coding)
{
const unsigned char *src, *end;
Lisp_Object eol_type = CODING_ID_EOL_TYPE (coding->id);
@ -6096,21 +6097,20 @@ detect_ascii (struct coding_system *coding)
src = coding->source;
end = src + coding->src_bytes;
if (inhibit_eol_conversion)
if (inhibit_eol_conversion
|| eol_seen != EOL_SEEN_NONE)
{
/* We don't have to check EOL format. */
while (src < end && !( *src & 0x80)) src++;
eol_seen = EOL_SEEN_LF;
adjust_coding_eol_type (coding, eol_seen);
}
else if (eol_seen != EOL_SEEN_NONE)
{
/* We don't have to check EOL format either. */
while (src < end && !(*src & 0x80)) src++;
if (inhibit_eol_conversion)
{
eol_seen = EOL_SEEN_LF;
adjust_coding_eol_type (coding, eol_seen);
}
}
else
{
end--; /* We look ahead one byte. */
end--; /* We look ahead one byte for "CR LF". */
while (src < end)
{
int c = *src;
@ -6118,6 +6118,69 @@ detect_ascii (struct coding_system *coding)
if (c & 0x80)
break;
src++;
if (c == '\r')
{
if (*src == '\n')
{
eol_seen |= EOL_SEEN_CRLF;
src++;
}
else
eol_seen |= EOL_SEEN_CR;
}
else if (c == '\n')
eol_seen |= EOL_SEEN_LF;
}
if (src == end)
{
int c = *src;
/* All bytes but the last one C are ASCII. */
if (! (c & 0x80))
{
if (c == '\r')
eol_seen |= EOL_SEEN_CR;
else if (c == '\n')
eol_seen |= EOL_SEEN_LF;
src++;
}
}
}
coding->head_ascii = src - coding->source;
coding->eol_seen = eol_seen;
return (coding->head_ascii);
}
/* Return the number of characters at the source if all the bytes are
valid UTF-8 (of Unicode range). Otherwise, return -1. By side
effects, update coding->eol_seen. The value of coding->eol_seen is
"logical or" of EOL_SEEN_LF, EOL_SEEN_CR, and EOL_SEEN_CRLF, but
the value is reliable only when all the source bytes are valid
UTF-8. */
static int
check_utf_8 (struct coding_system *coding)
{
const unsigned char *src, *end;
int eol_seen = coding->eol_seen;
int nchars = coding->head_ascii;
if (coding->head_ascii < 0)
check_ascii (coding);
else
coding_set_source (coding);
src = coding->source + coding->head_ascii;
/* We look ahead one byte for CR LF. */
end = coding->source + coding->src_bytes - 1;
while (src < end)
{
int c = *src;
if (UTF_8_1_OCTET_P (*src))
{
src++;
if (c < 0x20)
{
if (c == '\r')
@ -6126,6 +6189,7 @@ detect_ascii (struct coding_system *coding)
{
eol_seen |= EOL_SEEN_CRLF;
src++;
nchars++;
}
else
eol_seen |= EOL_SEEN_CR;
@ -6134,27 +6198,58 @@ detect_ascii (struct coding_system *coding)
eol_seen |= EOL_SEEN_LF;
}
}
if (src > end)
/* The last two bytes are CR LF, which means that we have
scanned all bytes. */
end++;
else if (src == end)
else if (UTF_8_2_OCTET_LEADING_P (c))
{
end++;
if (! (*src & 0x80))
{
if (*src == '\r')
eol_seen |= EOL_SEEN_CR;
else if (*src == '\n')
eol_seen |= EOL_SEEN_LF;
src++;
}
if (c < 0xC2 /* overlong sequence */
|| src + 1 >= end
|| ! UTF_8_EXTRA_OCTET_P (src[1]))
return -1;
src += 2;
}
adjust_coding_eol_type (coding, eol_seen);
else if (UTF_8_3_OCTET_LEADING_P (c))
{
if (src + 2 >= end
|| ! (UTF_8_EXTRA_OCTET_P (src[1])
&& UTF_8_EXTRA_OCTET_P (src[2])))
return -1;
c = (((c & 0xF) << 12)
| ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
if (c < 0x800 /* overlong sequence */
|| (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */
return -1;
src += 3;
}
else if (UTF_8_4_OCTET_LEADING_P (c))
{
if (src + 3 >= end
|| ! (UTF_8_EXTRA_OCTET_P (src[1])
&& UTF_8_EXTRA_OCTET_P (src[2])
&& UTF_8_EXTRA_OCTET_P (src[3])))
return -1;
c = (((c & 0x7) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
if (c < 0x10000 /* overlong sequence */
|| c >= 0x110000) /* non-Unicode character */
return -1;
src += 4;
}
else
return -1;
nchars++;
}
if (src == end)
{
if (! UTF_8_1_OCTET_P (*src))
return -1;
nchars++;
if (*src == '\r')
eol_seen |= EOL_SEEN_CR;
else if (*src == '\n')
eol_seen |= EOL_SEEN_LF;
}
coding->head_ascii = src - coding->source;
coding->eol_seen = eol_seen;
return (src == end);
return nchars;
}
@ -6269,6 +6364,9 @@ adjust_coding_eol_type (struct coding_system *coding, int eol_seen)
Lisp_Object eol_type;
eol_type = CODING_ID_EOL_TYPE (coding->id);
if (! VECTORP (eol_type))
/* Already adjusted. */
return eol_type;
if (eol_seen & EOL_SEEN_LF)
{
coding->id = CODING_SYSTEM_ID (AREF (eol_type, 0));
@ -6360,7 +6458,8 @@ detect_coding (struct coding_system *coding)
{
coding->eol_seen |= EOL_SEEN_CRLF;
src++;
coding->head_ascii++;
if (! eight_bit_found)
coding->head_ascii++;
}
else
coding->eol_seen |= EOL_SEEN_CR;
@ -6461,9 +6560,14 @@ detect_coding (struct coding_system *coding)
coding_systems
= AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom);
detect_info.found = detect_info.rejected = 0;
if (detect_ascii (coding))
if (check_ascii (coding) == coding->src_bytes)
{
int head_ascii = coding->head_ascii;
if (coding->eol_seen != EOL_SEEN_NONE)
adjust_coding_eol_type (coding, coding->eol_seen);
setup_coding_system (XCDR (coding_systems), coding);
coding->head_ascii = head_ascii;
}
else
{
@ -7620,15 +7724,27 @@ decode_coding_gap (struct coding_system *coding,
if (CODING_REQUIRE_DETECTION (coding))
detect_coding (coding);
attrs = CODING_ID_ATTRS (coding->id);
if (! disable_ascii_optimization)
if (! disable_ascii_optimization
&& ! coding->src_multibyte
&& ! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
&& NILP (CODING_ATTR_POST_READ (attrs))
&& NILP (get_translation_table (attrs, 0, NULL)))
{
if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
&& NILP (CODING_ATTR_POST_READ (attrs))
&& NILP (get_translation_table (attrs, 0, NULL))
&& (coding->head_ascii >= 0 /* We've already called detect_coding */
? coding->head_ascii == bytes
: detect_ascii (coding)))
chars = coding->head_ascii;
if (chars < 0)
chars = check_ascii (coding);
if (chars != bytes)
{
if (EQ (CODING_ATTR_TYPE (attrs), Qutf_8))
chars = check_utf_8 (coding);
else
chars = -1;
}
if (chars >= 0)
{
if (coding->eol_seen != EOL_SEEN_NONE)
adjust_coding_eol_type (coding, coding->eol_seen);
if (coding->eol_seen == EOL_SEEN_CR)
{
unsigned char *src_end = GAP_END_ADDR;
@ -7645,6 +7761,7 @@ decode_coding_gap (struct coding_system *coding,
unsigned char *src = GAP_END_ADDR;
unsigned char *src_beg = src - coding->src_bytes;
unsigned char *dst = src;
ptrdiff_t diff;
while (src_beg < src)
{
@ -7652,10 +7769,13 @@ decode_coding_gap (struct coding_system *coding,
if (*src == '\n')
src--;
}
bytes -= dst - src;
diff = dst - src;
bytes -= diff;
chars -= diff;
}
coding->produced_char = coding->produced = bytes;
insert_from_gap (bytes, bytes, 1);
coding->produced = bytes;
coding->produced_char = chars;
insert_from_gap (chars, bytes, 1);
return;
}
}
@ -10877,7 +10997,7 @@ decode text as usual. */);
DEFVAR_BOOL ("disable-ascii-optimization", disable_ascii_optimization,
doc: /* If non-nil, Emacs does not optimize code decoder for ASCII files.
Internal use only. Removed after the experimental optimizer gets stable. */);
disable_ascii_optimization = 1;
disable_ascii_optimization = 0;
DEFVAR_LISP ("translation-table-for-input", Vtranslation_table_for_input,
doc: /* Char table for translating self-inserting characters.

31
src/fileio.c
View file

@ -81,6 +81,25 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define DRIVE_LETTER(x) c_tolower (x)
#endif
#ifdef HAVE_POSIX_ACL
/* FIXME: this macro was copied from gnulib's private acl-internal.h
header file. */
/* Recognize some common errors such as from an NFS mount that does
not support ACLs, even when local drives do. */
#if defined __APPLE__ && defined __MACH__ /* Mac OS X */
#define ACL_NOT_WELL_SUPPORTED(Err) \
((Err) == ENOTSUP || (Err) == ENOSYS || (Err) == EINVAL || (Err) == EBUSY || (Err) == ENOENT)
#elif defined EOPNOTSUPP /* Tru64 NFS */
#define ACL_NOT_WELL_SUPPORTED(Err) \
((Err) == ENOTSUP || (Err) == ENOSYS || (Err) == EINVAL || (Err) == EBUSY || (Err) == EOPNOTSUPP)
#elif defined WINDOWSNT
#define ACL_NOT_WELL_SUPPORTED(Err) ((Err) == ENOTSUP)
#else
#define ACL_NOT_WELL_SUPPORTED(Err) \
((Err) == ENOTSUP || (Err) == ENOSYS || (Err) == EINVAL || (Err) == EBUSY)
#endif
#endif /* HAVE_POSIX_ACL */
#include "systime.h"
#include <allocator.h>
#include <careadlinkat.h>
@ -2011,7 +2030,7 @@ entries (depending on how Emacs was built). */)
{
#ifdef HAVE_POSIX_ACL
acl = acl_get_file (SDATA (encoded_file), ACL_TYPE_ACCESS);
if (acl == NULL && errno != ENOTSUP)
if (acl == NULL && !ACL_NOT_WELL_SUPPORTED (errno))
report_file_error ("Getting ACL", Fcons (file, Qnil));
#endif
}
@ -2055,7 +2074,7 @@ entries (depending on how Emacs was built). */)
{
bool fail =
acl_set_file (SDATA (encoded_newname), ACL_TYPE_ACCESS, acl) != 0;
if (fail && errno != ENOTSUP)
if (fail && !ACL_NOT_WELL_SUPPORTED (errno))
report_file_error ("Setting ACL", Fcons (newname, Qnil));
acl_free (acl);
@ -2087,7 +2106,7 @@ entries (depending on how Emacs was built). */)
#ifdef HAVE_POSIX_ACL
acl = acl_get_fd (ifd);
if (acl == NULL && errno != ENOTSUP)
if (acl == NULL && !ACL_NOT_WELL_SUPPORTED (errno))
report_file_error ("Getting ACL", Fcons (file, Qnil));
#endif
}
@ -2176,7 +2195,7 @@ entries (depending on how Emacs was built). */)
if (acl != NULL)
{
bool fail = acl_set_fd (ofd, acl) != 0;
if (fail && errno != ENOTSUP)
if (fail && !ACL_NOT_WELL_SUPPORTED (errno))
report_file_error ("Setting ACL", Fcons (newname, Qnil));
acl_free (acl);
@ -3174,7 +3193,7 @@ support. */)
fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
acl)
!= 0);
if (fail && errno != ENOTSUP)
if (fail && !ACL_NOT_WELL_SUPPORTED (errno))
report_file_error ("Setting ACL", Fcons (absname, Qnil));
acl_free (acl);
@ -5816,7 +5835,7 @@ before any other event (mouse or keypress) is handled. */)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& use_file_dialog
&& have_menus_p ())
&& window_system_available (SELECTED_FRAME ()))
return Qt;
#endif
return Qnil;

7
src/fns.c
View file

@ -1551,7 +1551,7 @@ the value of a list `foo'. */)
tail = list;
prev = Qnil;
while (!NILP (tail))
while (CONSP (tail))
{
CHECK_LIST_CONS (tail, list);
tem = XCAR (tail);
@ -2443,10 +2443,9 @@ is nil, and `use-dialog-box' is non-nil. */)
CHECK_STRING (prompt);
#ifdef HAVE_MENUS
if (FRAME_WINDOW_P (SELECTED_FRAME ())
&& (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
&& window_system_available (SELECTED_FRAME ()))
{
Lisp_Object pane, menu, obj;
redisplay_preserve_echo_area (4);

4
src/font.c
View file

@ -4844,11 +4844,9 @@ If the named font is not yet loaded, return nil. */)
Lisp_Object info;
Lisp_Object font_object;
(*check_window_system_func) ();
if (! FONTP (name))
CHECK_STRING (name);
f = decode_live_frame (frame);
f = decode_window_system_frame (frame);
if (STRINGP (name))
{

9
src/fontset.c
View file

@ -179,10 +179,6 @@ static int next_fontset_id;
font for each character. */
static Lisp_Object Vdefault_fontset;
/* Check if any window system is used now. */
void (*check_window_system_func) (void);
/* Prototype declarations for static functions. */
static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
@ -1213,7 +1209,7 @@ If REGEXPP is non-nil, PATTERN is a regular expression. */)
Lisp_Object fontset;
int id;
(*check_window_system_func) ();
check_window_system (NULL);
CHECK_STRING (pattern);
@ -1919,8 +1915,7 @@ format is the same as above. */)
Lisp_Object val, elt;
int c, i, j, k;
(*check_window_system_func) ();
check_window_system (NULL);
fontset = check_fontset_name (fontset, &frame);
/* Recode fontsets realized on FRAME from the base fontset FONTSET

3
src/fontset.h
View file

@ -26,9 +26,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#ifndef EMACS_FONTSET_H
#define EMACS_FONTSET_H
/* Check if any window system is used now. */
extern void (*check_window_system_func) (void);
struct face;
extern void free_face_fontset (FRAME_PTR, struct face *);

51
src/frame.c
View file

@ -149,6 +149,37 @@ decode_any_frame (register Lisp_Object frame)
return XFRAME (frame);
}
bool
window_system_available (struct frame *f)
{
if (f)
return FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f);
else
#ifdef HAVE_WINDOW_SYSTEM
return x_display_list != NULL;
#else
return 0;
#endif
}
struct frame *
decode_window_system_frame (Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
if (!window_system_available (f))
error ("Window system frame should be used");
return f;
}
void
check_window_system (struct frame *f)
{
if (!window_system_available (f))
error (f ? "Window system frame should be used"
: "Window system is not in use or not initialized");
}
static void
set_menu_bar_lines_1 (Lisp_Object window, int n)
{
@ -803,10 +834,18 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
if (FRAME_TERMCAP_P (XFRAME (frame)) || FRAME_MSDOS_P (XFRAME (frame)))
{
if (FRAMEP (FRAME_TTY (XFRAME (frame))->top_frame))
/* Mark previously displayed frame as now obscured. */
SET_FRAME_VISIBLE (XFRAME (FRAME_TTY (XFRAME (frame))->top_frame), 2);
SET_FRAME_VISIBLE (XFRAME (frame), 1);
Lisp_Object top_frame = FRAME_TTY (XFRAME (frame))->top_frame;
/* Don't mark the frame garbaged and/or obscured if we are
switching to the frame that is already the top frame of that
TTY. */
if (!EQ (frame, top_frame))
{
if (FRAMEP (top_frame))
/* Mark previously displayed frame as now obscured. */
SET_FRAME_VISIBLE (XFRAME (top_frame), 2);
SET_FRAME_VISIBLE (XFRAME (frame), 1);
}
FRAME_TTY (XFRAME (frame))->top_frame = frame;
}
@ -3493,9 +3532,7 @@ and the class is `Emacs.CLASS.SUBCLASS'. */)
(Lisp_Object attribute, Lisp_Object class, Lisp_Object component,
Lisp_Object subclass)
{
#ifdef HAVE_X_WINDOWS
check_x ();
#endif
check_window_system (NULL);
return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
attribute, class, component, subclass);

3
src/frame.h
View file

@ -958,6 +958,7 @@ extern Lisp_Object Qnoelisp;
extern struct frame *last_nonminibuf_frame;
extern void set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
extern struct frame *decode_window_system_frame (Lisp_Object);
extern struct frame *decode_live_frame (Lisp_Object);
extern struct frame *decode_any_frame (Lisp_Object);
extern struct frame *make_initial_frame (void);
@ -968,6 +969,8 @@ extern struct frame *make_frame_without_minibuffer (Lisp_Object,
struct kboard *,
Lisp_Object);
#endif /* HAVE_WINDOW_SYSTEM */
extern bool window_system_available (struct frame *);
extern void check_window_system (struct frame *);
extern void frame_make_pointer_invisible (void);
extern void frame_make_pointer_visible (void);
extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object);

10
src/image.c
View file

@ -889,7 +889,7 @@ or omitted means use the selected frame. */)
size = Qnil;
if (valid_image_p (spec))
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
ptrdiff_t id = lookup_image (f, spec);
struct image *img = IMAGE_FROM_ID (f, id);
int width = img->width + 2 * img->hmargin;
@ -919,7 +919,7 @@ or omitted means use the selected frame. */)
mask = Qnil;
if (valid_image_p (spec))
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
ptrdiff_t id = lookup_image (f, spec);
struct image *img = IMAGE_FROM_ID (f, id);
if (img->mask)
@ -942,7 +942,7 @@ or omitted means use the selected frame. */)
ext = Qnil;
if (valid_image_p (spec))
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
ptrdiff_t id = lookup_image (f, spec);
struct image *img = IMAGE_FROM_ID (f, id);
ext = img->lisp_data;
@ -1550,7 +1550,7 @@ which is then usually a filename. */)
if (!(EQ (filter, Qnil) || FRAMEP (filter)))
clear_image_caches (filter);
else
clear_image_cache (check_x_frame (filter), Qt);
clear_image_cache (decode_window_system_frame (filter), Qt);
return Qnil;
}
@ -1581,7 +1581,7 @@ FRAME t means refresh the image on all frames. */)
}
}
else
uncache_image (check_x_frame (frame), spec);
uncache_image (decode_window_system_frame (frame), spec);
return Qnil;
}

8
src/indent.c
View file

@ -2006,11 +2006,15 @@ whether or not it is currently displayed in some window. */)
const char *s = SSDATA (it.string);
const char *e = s + SBYTES (it.string);
disp_string_at_start_p =
/* If it.area is anything but TEXT_AREA, we need not bother
about the display string, as it doesn't affect cursor
positioning. */
disp_string_at_start_p =
it.string_from_display_prop_p && it.area == TEXT_AREA;
it.area == TEXT_AREA
&& it.string_from_display_prop_p
/* A display string on anything but buffer text (e.g., on
an overlay string) doesn't affect cursor positioning. */
&& (it.sp > 0 && it.stack[it.sp - 1].method == GET_FROM_BUFFER);
while (s < e)
{
if (*s++ == '\n')

15
src/insdel.c
View file

@ -983,6 +983,9 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
void
insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail)
{
int ins_charpos = GPT;
int ins_bytepos = GPT_BYTE;
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
nchars = nbytes;
@ -1003,18 +1006,18 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail)
eassert (GPT <= GPT_BYTE);
adjust_overlays_for_insert (GPT - nchars, nchars);
adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes,
GPT, GPT_BYTE, 0);
adjust_overlays_for_insert (ins_charpos, nchars);
adjust_markers_for_insert (ins_charpos, ins_bytepos,
ins_charpos + nchars, ins_bytepos + nbytes, 0);
if (buffer_intervals (current_buffer))
{
offset_intervals (current_buffer, GPT - nchars, nchars);
graft_intervals_into_buffer (NULL, GPT - nchars, nchars,
offset_intervals (current_buffer, ins_charpos, nchars);
graft_intervals_into_buffer (NULL, ins_charpos, nchars,
current_buffer, 0);
}
if (! text_at_gap_tail && GPT - nchars < PT)
if (ins_charpos < PT)
adjust_point (nchars, nbytes);
check_markers ();

21
src/keyboard.c
View file

@ -72,7 +72,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
/* Variables for blockinput.h: */
/* Variables for blockinput.h: */
/* Positive if interrupt input is blocked right now. */
volatile int interrupt_input_blocked;
@ -4198,16 +4198,7 @@ timer_start_idle (void)
timer_last_idleness_start_time = timer_idleness_start_time;
/* Mark all idle-time timers as once again candidates for running. */
for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
{
Lisp_Object timer;
timer = XCAR (timers);
if (!VECTORP (timer) || ASIZE (timer) != 9)
continue;
ASET (timer, 0, Qnil);
}
call0 (intern ("internal-timer-start-idle"));
}
/* Record that Emacs is no longer idle, so stop running idle-time timers. */
@ -4337,10 +4328,10 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
}
idle_timer_ripe = EMACS_TIME_LE (idle_timer_time, idleness_now);
idle_timer_difference =
(idle_timer_ripe
? sub_emacs_time (idleness_now, idle_timer_time)
: sub_emacs_time (idle_timer_time, idleness_now));
idle_timer_difference
= (idle_timer_ripe
? sub_emacs_time (idleness_now, idle_timer_time)
: sub_emacs_time (idle_timer_time, idleness_now));
}
/* Decide which timer is the next timer,

5
src/lisp.h
View file

@ -3771,11 +3771,6 @@ extern void syms_of_xml (void);
extern void xml_cleanup_parser (void);
#endif
#ifdef HAVE_MENUS
/* Defined in (x|w32)fns.c, nsfns.m... */
extern int have_menus_p (void);
#endif
#ifdef HAVE_DBUS
/* Defined in dbusbind.c. */
void syms_of_dbusbind (void);

3
src/menu.c
View file

@ -1085,7 +1085,8 @@ no quit occurs and `x-popup-menu' returns nil. */)
#ifdef HAVE_MENUS
{
bool get_current_pos_p = 0;
/* FIXME!! check_w32 (); or check_x (); or check_ns (); */
check_window_system (SELECTED_FRAME ());
/* Decode the first argument: find the window and the coordinates. */
if (EQ (position, Qt)

8
src/minibuf.c
View file

@ -1800,17 +1800,21 @@ the values STRING, PREDICATE and `lambda'. */)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
i = hash_lookup (h, string, NULL);
Lisp_Object key = Qnil;
if (i >= 0)
tem = HASH_KEY (h, i);
else
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i))
&& (key = HASH_KEY (h, i),
SYMBOLP (key) ? key = Fsymbol_name (key) : key,
STRINGP (key))
&& EQ (Fcompare_strings (string, make_number (0), Qnil,
HASH_KEY (h, i), make_number (0) , Qnil,
key, make_number (0) , Qnil,
completion_ignore_case ? Qt : Qnil),
Qt))
{
tem = HASH_KEY (h, i);
tem = key;
break;
}
if (!STRINGP (tem))

7
src/msdos.c
View file

@ -1920,7 +1920,7 @@ dos_get_saved_screen (char **screen, int *rows, int *cols)
/* We are not X, but we can emulate it well enough for our needs... */
void
check_x (void)
check_window_system (void)
{
if (! FRAME_MSDOS_P (SELECTED_FRAME ()))
error ("Not running under a window system");
@ -2983,11 +2983,6 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help)
/* --------------------------- X Menu emulation ---------------------- */
/* Report availability of menus. */
int
have_menus_p (void) { return 1; }
/* Create a brand new menu structure. */
XMenu *

145
src/nsfns.m
View file

@ -107,43 +107,6 @@ Updated by Christian Limpach (chris@nice.ch)
========================================================================== */
void
check_ns (void)
{
if (NSApp == nil)
error ("OpenStep is not in use or not initialized");
}
/* Nonzero if we can use mouse menus. */
int
have_menus_p (void)
{
return NSApp != nil;
}
/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
and checking validity for NS. */
static FRAME_PTR
check_ns_frame (Lisp_Object frame)
{
FRAME_PTR f;
if (NILP (frame))
f = SELECTED_FRAME ();
else
{
CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
}
if (! FRAME_NS_P (f))
error ("non-Nextstep frame used");
return f;
}
/* Let the user specify an Nextstep display with a frame.
nil stands for the selected frame--or, if that is not an Nextstep frame,
the first Nextstep display on the list. */
@ -1145,8 +1108,6 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
Lisp_Object tfont, tfontsize;
static int desc_ctr = 1;
check_ns ();
/* x_get_arg modifies parms. */
parms = Fcopy_alist (parms);
@ -1418,7 +1379,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
FRAME nil means use the selected frame. */)
(Lisp_Object frame)
{
struct frame *f = check_ns_frame (frame);
struct frame *f = decode_window_system_frame (frame);
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
if (dpyinfo->x_focus_frame != f)
@ -1439,18 +1400,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
doc: /* Pop up the font panel. */)
(Lisp_Object frame)
{
id fm;
struct frame *f;
check_ns ();
fm = [NSFontManager sharedFontManager];
if (NILP (frame))
f = SELECTED_FRAME ();
else
{
CHECK_FRAME (frame);
f = XFRAME (frame);
}
struct frame *f = decode_window_system_frame (frame);
id fm = [NSFontManager sharedFontManager];
[fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
isMultiple: NO];
@ -1464,17 +1415,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
doc: /* Pop up the color panel. */)
(Lisp_Object frame)
{
struct frame *f;
check_ns ();
if (NILP (frame))
f = SELECTED_FRAME ();
else
{
CHECK_FRAME (frame);
f = XFRAME (frame);
}
check_window_system (NULL);
[NSApp orderFrontColorPanel: NSApp];
return Qnil;
}
@ -1503,7 +1444,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
NSString *initS = NILP (init) || !STRINGP (init) ? nil :
[NSString stringWithUTF8String: SSDATA (init)];
check_ns ();
check_window_system (NULL);
if (fileDelegate == nil)
fileDelegate = [EmacsFileDelegate new];
@ -1594,11 +1535,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
{
const char *value;
check_ns ();
check_window_system (NULL);
if (NILP (owner))
owner = build_string([ns_app_name UTF8String]);
CHECK_STRING (name);
/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SSDATA (name)); */
value = ns_get_defaults_value (SSDATA (name));
@ -1614,7 +1554,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
If VALUE is nil, the default is removed. */)
(Lisp_Object owner, Lisp_Object name, Lisp_Object value)
{
check_ns ();
check_window_system (NULL);
if (NILP (owner))
owner = build_string ([ns_app_name UTF8String]);
CHECK_STRING (name);
@ -1642,7 +1582,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
doc: /* This function is a no-op. It is only present for completeness. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
/* This function has no real equivalent under NeXTstep. Return nil to
indicate this. */
return Qnil;
@ -1692,7 +1632,7 @@ and GNUstep implementations ("distributor-specific release
{
int num;
check_ns ();
check_ns_display_info (display);
num = [[NSScreen screens] count];
return (num != 0) ? make_number (num) : Qnil;
@ -1706,7 +1646,7 @@ and GNUstep implementations ("distributor-specific release
If omitted or nil, the selected frame's display is used. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
return make_number ((int)
([ns_get_screen (display) frame].size.height/(92.0/25.4)));
}
@ -1719,7 +1659,7 @@ and GNUstep implementations ("distributor-specific release
If omitted or nil, the selected frame's display is used. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
return make_number ((int)
([ns_get_screen (display) frame].size.width/(92.0/25.4)));
}
@ -1733,7 +1673,7 @@ and GNUstep implementations ("distributor-specific release
If omitted or nil, the selected frame's display is used. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
switch ([ns_get_window (display) backingType])
{
case NSBackingStoreBuffered:
@ -1759,7 +1699,8 @@ and GNUstep implementations ("distributor-specific release
(Lisp_Object display)
{
NSWindowDepth depth;
check_ns ();
check_ns_display_info (display);
depth = [ns_get_screen (display) depth];
if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
@ -1786,7 +1727,7 @@ and GNUstep implementations ("distributor-specific release
If omitted or nil, the selected frame's display is used. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
switch ([ns_get_window (display) backingType])
{
case NSBackingStoreBuffered:
@ -1836,11 +1777,10 @@ and GNUstep implementations ("distributor-specific release
DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1, 1, 0,
doc: /* Close the connection to the current Nextstep display server.
The argument DISPLAY is currently ignored. */)
DISPLAY should be a frame, the display name as a string, or a terminal ID. */)
(Lisp_Object display)
{
check_ns ();
/*ns_delete_terminal (dpyinfo->terminal); */
check_ns_display_info (display);
[NSApp terminate: NSApp];
return Qnil;
}
@ -1865,7 +1805,7 @@ and GNUstep implementations ("distributor-specific release
doc: /* Hides all applications other than Emacs. */)
(void)
{
check_ns ();
check_window_system (NULL);
[NSApp hideOtherApplications: NSApp];
return Qnil;
}
@ -1878,7 +1818,7 @@ and GNUstep implementations ("distributor-specific release
the active application. */)
(Lisp_Object on)
{
check_ns ();
check_window_system (NULL);
if (EQ (on, intern ("activate")))
{
[NSApp unhide: NSApp];
@ -1897,7 +1837,7 @@ and GNUstep implementations ("distributor-specific release
doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
(void)
{
check_ns ();
check_window_system (NULL);
[NSApp orderFrontStandardAboutPanel: nil];
return Qnil;
}
@ -1975,7 +1915,7 @@ and GNUstep implementations ("distributor-specific release
NSMenu *svcs;
id delegate;
check_ns ();
check_window_system (NULL);
svcs = [[NSMenu alloc] initWithTitle: @"Services"];
[NSApp setServicesMenu: svcs];
[NSApp registerServicesMenuSendTypes: ns_send_types
@ -2028,7 +1968,7 @@ and GNUstep implementations ("distributor-specific release
char *utfStr;
CHECK_STRING (service);
check_ns ();
check_window_system (NULL);
utfStr = SSDATA (service);
svcName = [NSString stringWithUTF8String: utfStr];
@ -2152,7 +2092,7 @@ and GNUstep implementations ("distributor-specific release
NSEvent *nxev;
CHECK_STRING (script);
check_ns ();
check_window_system (NULL);
block_input ();
@ -2201,15 +2141,6 @@ and GNUstep implementations ("distributor-specific release
========================================================================== */
/* called from image.c */
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
return check_ns_frame (frame);
}
/* called from frame.c */
struct ns_display_info *
check_x_display_info (Lisp_Object frame)
@ -2235,7 +2166,7 @@ and GNUstep implementations ("distributor-specific release
/* remove appname prefix; TODO: allow for !="Emacs" */
char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
const char *res;
check_ns ();
check_window_system (NULL);
if (inhibit_x_resources)
/* --quick was passed, so this is a no-op. */
@ -2305,7 +2236,7 @@ and GNUstep implementations ("distributor-specific release
(Lisp_Object color, Lisp_Object frame)
{
NSColor * col;
check_ns ();
check_window_system (NULL);
return ns_lisp_to_color (color, &col) ? Qnil : Qt;
}
@ -2317,7 +2248,7 @@ and GNUstep implementations ("distributor-specific release
NSColor * col;
CGFloat red, green, blue, alpha;
check_ns ();
check_window_system (NULL);
CHECK_STRING (color);
if (ns_lisp_to_color (color, &col))
@ -2336,7 +2267,8 @@ and GNUstep implementations ("distributor-specific release
{
NSWindowDepth depth;
NSString *colorSpace;
check_ns ();
check_ns_display_info (display);
depth = [ns_get_screen (display) depth];
colorSpace = NSColorSpaceFromDepth (depth);
@ -2356,7 +2288,8 @@ and GNUstep implementations ("distributor-specific release
(Lisp_Object display)
{
NSWindowDepth depth;
check_ns ();
check_ns_display_info (display);
depth = [ns_get_screen (display) depth];
return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
@ -2371,7 +2304,7 @@ and GNUstep implementations ("distributor-specific release
If omitted or nil, that stands for the selected frame's display. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
return make_number ((int) [ns_get_screen (display) frame].size.width);
}
@ -2384,7 +2317,7 @@ and GNUstep implementations ("distributor-specific release
If omitted or nil, that stands for the selected frame's display. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
return make_number ((int) [ns_get_screen (display) frame].size.height);
}
@ -2404,7 +2337,7 @@ The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
NSScreen *screen;
NSRect vScreen;
check_ns ();
check_ns_display_info (display);
screen = ns_get_screen (display);
if (!screen)
return Qnil;
@ -2428,7 +2361,7 @@ The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
If omitted or nil, that stands for the selected frame's display. */)
(Lisp_Object display)
{
check_ns ();
check_ns_display_info (display);
return make_number
(NSBitsPerPixelFromDepth ([ns_get_screen (display) depth]));
}
@ -2442,10 +2375,7 @@ The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
If omitted or nil, that stands for the selected frame's display. */)
(Lisp_Object display)
{
struct ns_display_info *dpyinfo;
check_ns ();
dpyinfo = check_ns_display_info (display);
struct ns_display_info *dpyinfo = check_ns_display_info (display);
/* We force 24+ bit depths to 24-bit to prevent an overflow. */
return make_number (1 << min (dpyinfo->n_planes, 24));
}
@ -2558,7 +2488,7 @@ DY added (default is -10).
CHECK_STRING (string);
str = SSDATA (string);
f = check_x_frame (frame);
f = decode_window_system_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
else
@ -2787,9 +2717,6 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
/* used only in fontset.c */
check_window_system_func = check_ns;
as_status = 0;
as_script = Qnil;
as_result = 0;

4
src/nsmenu.m
View file

@ -1409,8 +1409,6 @@ - (NSRect) frame
NSTRACE (x-popup-dialog);
check_ns ();
isQ = NILP (header);
if (EQ (position, Qt)
@ -1448,6 +1446,8 @@ - (NSRect) frame
else
CHECK_WINDOW (window);
check_window_system (f);
p.x = (int)f->left_pos + ((int)FRAME_COLUMN_WIDTH (f) * f->text_cols)/2;
p.y = (int)f->top_pos + (FRAME_LINE_HEIGHT (f) * f->text_lines)/2;

15
src/nsselect.m
View file

@ -354,8 +354,7 @@ Updated by Christian Limpach (chris@nice.ch)
Lisp_Object successful_p = Qnil, rest;
Lisp_Object target_symbol, data;
check_ns ();
check_window_system (NULL);
CHECK_SYMBOL (selection);
if (NILP (value))
error ("selection value may not be nil.");
@ -409,7 +408,7 @@ Updated by Christian Limpach (chris@nice.ch)
(Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
{
id pb;
check_ns ();
check_window_system (NULL);
CHECK_SYMBOL (selection);
if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil;
@ -436,7 +435,7 @@ Updated by Christian Limpach (chris@nice.ch)
id pb;
NSArray *types;
check_ns ();
check_window_system (NULL);
CHECK_SYMBOL (selection);
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
@ -464,7 +463,7 @@ Updated by Christian Limpach (chris@nice.ch)
On Nextstep, TERMINAL is unused. */)
(Lisp_Object selection, Lisp_Object terminal)
{
check_ns ();
check_window_system (NULL);
CHECK_SYMBOL (selection);
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
@ -492,7 +491,7 @@ Updated by Christian Limpach (chris@nice.ch)
{
Lisp_Object val;
check_ns ();
check_window_system (NULL);
CHECK_SYMBOL (selection_name);
CHECK_SYMBOL (target_type);
val = ns_get_local_selection (selection_name, target_type);
@ -516,7 +515,7 @@ Updated by Christian Limpach (chris@nice.ch)
(Lisp_Object selection)
{
id pb;
check_ns ();
check_window_system (NULL);
pb = ns_symbol_to_pb (selection);
return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
}
@ -529,7 +528,7 @@ Updated by Christian Limpach (chris@nice.ch)
(Lisp_Object selection, Lisp_Object string)
{
id pb;
check_ns ();
check_window_system (NULL);
pb = ns_symbol_to_pb (selection);
if (pb != nil) ns_string_to_pasteboard (pb, string);
return Qnil;

3
src/nsterm.h
View file

@ -577,8 +577,6 @@ extern Lisp_Object ns_display_name_list;
extern struct ns_display_info *ns_display_info_for_name (Lisp_Object name);
struct ns_display_info *check_x_display_info (Lisp_Object frame);
FRAME_PTR check_x_frame (Lisp_Object frame);
struct ns_output
{
@ -764,7 +762,6 @@ extern void ns_clear_frame (struct frame *f);
extern const char *ns_xlfd_to_fontname (const char *xlfd);
extern void check_ns (void);
extern Lisp_Object ns_map_event_to_object (void);
#ifdef __OBJC__
extern Lisp_Object ns_string_from_pasteboard (id pb);

40
src/nsterm.m
View file

@ -1012,8 +1012,9 @@ Free a pool and temporary objects it refers to (callable from C)
Bring window to foreground and make it active
-------------------------------------------------------------------------- */
{
NSView *view = FRAME_NS_VIEW (f);
check_ns ();
NSView *view;
check_window_system (f);
view = FRAME_NS_VIEW (f);
block_input ();
if (FRAME_VISIBLE_P (f))
[[view window] makeKeyAndOrderFront: NSApp];
@ -1027,8 +1028,9 @@ Free a pool and temporary objects it refers to (callable from C)
Send window to back
-------------------------------------------------------------------------- */
{
NSView *view = FRAME_NS_VIEW (f);
check_ns ();
NSView *view;
check_window_system (f);
view = FRAME_NS_VIEW (f);
block_input ();
[[view window] orderBack: NSApp];
unblock_input ();
@ -1131,9 +1133,10 @@ Free a pool and temporary objects it refers to (callable from C)
External: Hide the window (X11 semantics)
-------------------------------------------------------------------------- */
{
NSView * view = FRAME_NS_VIEW (f);
NSView *view;
NSTRACE (x_make_frame_invisible);
check_ns ();
check_window_system (f);
view = FRAME_NS_VIEW (f);
[[view window] orderOut: NSApp];
SET_FRAME_VISIBLE (f, 0);
SET_FRAME_ICONIFIED (f, 0);
@ -1146,10 +1149,13 @@ Free a pool and temporary objects it refers to (callable from C)
External: Iconify window
-------------------------------------------------------------------------- */
{
NSView * view = FRAME_NS_VIEW (f);
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
NSView *view;
struct ns_display_info *dpyinfo;
NSTRACE (x_iconify_frame);
check_ns ();
check_window_system (f);
view = FRAME_NS_VIEW (f);
dpyinfo = FRAME_NS_DISPLAY_INFO (f);
if (dpyinfo->x_highlight_frame == f)
dpyinfo->x_highlight_frame = 0;
@ -1174,11 +1180,15 @@ Free a pool and temporary objects it refers to (callable from C)
void
x_free_frame_resources (struct frame *f)
{
NSView *view = FRAME_NS_VIEW (f);
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
NSView *view;
struct ns_display_info *dpyinfo;
Mouse_HLInfo *hlinfo;
NSTRACE (x_free_frame_resources);
check_ns ();
check_window_system (f);
view = FRAME_NS_VIEW (f);
dpyinfo = FRAME_NS_DISPLAY_INFO (f);
hlinfo = MOUSE_HL_INFO (f);
[(EmacsView *)view setWindowClosing: YES]; /* may not have been informed */
@ -1219,7 +1229,7 @@ Free a pool and temporary objects it refers to (callable from C)
-------------------------------------------------------------------------- */
{
NSTRACE (x_destroy_window);
check_ns ();
check_window_system (f);
x_free_frame_resources (f);
ns_window_num--;
}
@ -1873,7 +1883,7 @@ Free a pool and temporary objects it refers to (callable from C)
f = dpyinfo->x_focus_frame ? dpyinfo->x_focus_frame
: SELECTED_FRAME ();
if (f && f->output_data.ns) /* TODO: 2nd check no longer needed? */
if (f && FRAME_NS_P (f))
{
view = FRAME_NS_VIEW (*fp);

62
src/w32fns.c
View file

@ -95,10 +95,6 @@ static HWND hourglass_hwnd = NULL;
#define IDC_HAND MAKEINTRESOURCE(32649)
#endif
/* Nonzero if using Windows. */
static int w32_in_use;
Lisp_Object Qsuppress_icon;
Lisp_Object Qundefined_color;
Lisp_Object Qcancel_timer;
@ -239,37 +235,6 @@ HINSTANCE hinst = NULL;
static unsigned int sound_type = 0xFFFFFFFF;
#define MB_EMACS_SILENT (0xFFFFFFFF - 1)
/* Error if we are not connected to MS-Windows. */
void
check_w32 (void)
{
if (! w32_in_use)
error ("MS-Windows not in use or not initialized");
}
/* Nonzero if we can use mouse menus.
You should not call this unless HAVE_MENUS is defined. */
int
have_menus_p (void)
{
return w32_in_use;
}
/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
and checking validity for W32. */
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
if (! FRAME_W32_P (f))
error ("Non-W32 frame used");
return f;
}
/* Let the user specify a display with a frame.
nil stands for the selected frame--or, if that is not a w32 frame,
the first display on the list. */
@ -4567,7 +4532,7 @@ DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
doc: /* Give FRAME input focus, raising to foreground if necessary. */)
(Lisp_Object frame)
{
x_focus_on_frame (check_x_frame (frame));
x_focus_on_frame (decode_window_system_frame (frame));
return Qnil;
}
@ -4578,7 +4543,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
(Lisp_Object color, Lisp_Object frame)
{
XColor foo;
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
CHECK_STRING (color);
@ -4593,7 +4558,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
(Lisp_Object color, Lisp_Object frame)
{
XColor foo;
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
CHECK_STRING (color);
@ -4911,7 +4876,6 @@ x_display_info_for_name (Lisp_Object name)
if (dpyinfo == 0)
error ("Cannot connect to server %s", SDATA (name));
w32_in_use = 1;
XSETFASTINT (Vwindow_system_version, w32_major_version);
return dpyinfo;
@ -4941,7 +4905,7 @@ terminate Emacs if we can't open the connection.
/* If initialization has already been done, return now to avoid
overwriting critical parts of one_w32_display_info. */
if (w32_in_use)
if (window_system_available (NULL))
return Qnil;
if (! NILP (xrm_string))
@ -5010,8 +4974,6 @@ terminate Emacs if we can't open the connection.
error ("Cannot connect to server %s", SDATA (display));
}
w32_in_use = 1;
XSETFASTINT (Vwindow_system_version, w32_major_version);
return Qnil;
}
@ -5095,7 +5057,7 @@ FRAME. Default is to change on the edit X window. */)
(Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Atom prop_atom;
CHECK_STRING (prop);
@ -5121,7 +5083,7 @@ DEFUN ("x-delete-window-property", Fx_delete_window_property,
FRAME nil or omitted means use the selected frame. Value is PROP. */)
(Lisp_Object prop, Lisp_Object frame)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Atom prop_atom;
CHECK_STRING (prop);
@ -5157,7 +5119,7 @@ no value of TYPE (always string in the MS Windows case). */)
(Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Atom prop_atom;
int rc;
Lisp_Object prop_value = Qnil;
@ -5358,8 +5320,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
Lisp_Object buffer;
struct buffer *old_buffer;
check_w32 ();
/* Use this general default value to start with until we know if
this frame has a specified name. */
Vx_resource_name = Vinvocation_name;
@ -5703,7 +5663,7 @@ Text larger than the specified size is clipped. */)
GCPRO4 (string, parms, frame, timeout);
CHECK_STRING (string);
f = check_x_frame (frame);
f = decode_window_system_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
else
@ -6354,7 +6314,7 @@ screen saver if defined.
If optional parameter FRAME is not specified, use selected frame. */)
(Lisp_Object command, Lisp_Object frame)
{
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
CHECK_NUMBER (command);
@ -7312,8 +7272,6 @@ void
syms_of_w32fns (void)
{
globals_of_w32fns ();
/* This is zero if not using MS-Windows. */
w32_in_use = 0;
track_mouse_window = NULL;
w32_visible_system_caret_hwnd = NULL;
@ -7635,8 +7593,6 @@ only be necessary if the default setting causes problems. */);
defsubr (&Sdefault_printer_name);
defsubr (&Sset_message_beep);
check_window_system_func = check_w32;
hourglass_hwnd = NULL;
defsubr (&Sx_show_tip);

2
src/w32font.c
View file

@ -2467,7 +2467,7 @@ If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
in the font selection dialog. */)
(Lisp_Object frame, Lisp_Object exclude_proportional)
{
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
CHOOSEFONT cf;
LOGFONT lf;
TEXTMETRIC tm;

4
src/w32menu.c
View file

@ -140,8 +140,6 @@ otherwise it is "Question". */)
FRAME_PTR f = NULL;
Lisp_Object window;
check_w32 ();
/* Decode the first argument: find the window or frame to use. */
if (EQ (position, Qt)
|| (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
@ -194,6 +192,8 @@ otherwise it is "Question". */)
but I don't want to make one now. */
CHECK_WINDOW (window);
check_window_system (f);
#ifndef HAVE_DIALOGS
{

2
src/w32term.h
View file

@ -203,7 +203,6 @@ extern void x_focus_on_frame (struct frame *f);
extern struct w32_display_info *w32_term_init (Lisp_Object,
char *, char *);
extern void check_w32 (void);
extern int w32_defined_color (FRAME_PTR f, const char *color,
XColor *color_def, int alloc);
extern void x_set_window_size (struct frame *f, int change_grav,
@ -740,7 +739,6 @@ struct image;
struct face;
XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
struct frame * check_x_frame (Lisp_Object);
typedef DWORD (WINAPI * ClipboardSequence_Proc) (void);
typedef BOOL (WINAPI * AppendMenuW_Proc) (

37
src/window.c
View file

@ -485,17 +485,14 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
w = XWINDOW (window);
w->frozen_window_start_p = 0;
if (NILP (norecord))
{
w->use_time = ++window_select_count;
record_buffer (w->contents);
}
/* Make the selected window's buffer current. */
Fset_buffer (w->contents);
if (EQ (window, selected_window) && !inhibit_point_swap)
return window;
/* `switch-to-buffer' uses (select-window (selected-window)) as a "clever"
way to call record_buffer from Elisp, so it's important that we call
record_buffer before returning here. */
goto record_and_return;
sf = SELECTED_FRAME ();
if (XFRAME (WINDOW_FRAME (w)) != sf)
@ -514,9 +511,19 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap)
fset_selected_window (sf, window);
select_window_1 (window, inhibit_point_swap);
bset_last_selected_window (XBUFFER (w->contents), window);
windows_or_buffers_changed++;
record_and_return:
/* record_buffer can run QUIT, so make sure it is run only after we have
re-established the invariant between selected_window and selected_frame,
otherwise the temporary broken invariant might "escape" (bug#14161). */
if (NILP (norecord))
{
w->use_time = ++window_select_count;
record_buffer (w->contents);
}
return window;
}
@ -1490,7 +1497,12 @@ if it isn't already recorded. */)
b = XBUFFER (buf);
if (! NILP (update)
&& (windows_or_buffers_changed || !w->window_end_valid)
&& (windows_or_buffers_changed
|| !w->window_end_valid
|| b->clip_changed
|| b->prevent_redisplay_optimizations_p
|| w->last_modified < BUF_MODIFF (b)
|| w->last_overlay_modified < BUF_OVERLAY_MODIFF (b))
&& !noninteractive)
{
struct text_pos startp;
@ -1699,8 +1711,9 @@ Return nil if window display is not up-to-date. In that case, use
/* Fail if current matrix is not up-to-date. */
if (!w->window_end_valid
|| current_buffer->clip_changed
|| current_buffer->prevent_redisplay_optimizations_p
|| windows_or_buffers_changed
|| b->clip_changed
|| b->prevent_redisplay_optimizations_p
|| w->last_modified < BUF_MODIFF (b)
|| w->last_overlay_modified < BUF_OVERLAY_MODIFF (b))
return Qnil;
@ -2929,7 +2942,7 @@ window-start value is reasonable when this function is called. */)
replace_window (root, window, 1);
/* This must become SWINDOW anyway ....... */
/* This must become SWINDOW anyway ....... */
if (BUFFERP (w->contents) && !resize_failed)
{
/* Try to minimize scrolling, by setting the window start to the

12
src/xfaces.c
View file

@ -231,7 +231,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
#define x_display_info w32_display_info
#define check_x check_w32
#define GCGraphicsExposures 0
#endif /* HAVE_NTGUI */
@ -239,7 +238,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
#define x_display_info ns_display_info
#define check_x check_ns
#define GCGraphicsExposures 0
#endif /* HAVE_NS */
#endif /* HAVE_WINDOW_SYSTEM */
@ -1636,7 +1634,7 @@ the WIDTH times as wide as FACE on FRAME. */)
struct frame *f;
int size, avgwidth IF_LINT (= 0);
check_x ();
check_window_system (NULL);
CHECK_STRING (pattern);
if (! NILP (maximum))
@ -1645,8 +1643,8 @@ the WIDTH times as wide as FACE on FRAME. */)
if (!NILP (width))
CHECK_NUMBER (width);
/* We can't simply call check_x_frame because this function may be
called before any frame is created. */
/* We can't simply call decode_window_system_frame because
this function may be called before any frame is created. */
f = decode_live_frame (frame);
if (! FRAME_WINDOW_P (f))
{
@ -3925,8 +3923,8 @@ If FRAME is omitted or nil, use the selected frame. */)
struct frame *f;
Lisp_Object lface1, lface2;
/* Don't use check_x_frame here because this function is called
before X frames exist. At that time, if FRAME is nil,
/* Don't use decode_window_system_frame here because this function
is called before X frames exist. At that time, if FRAME is nil,
selected_frame will be used which is the frame dumped with
Emacs. That frame is not an X frame. */
f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);

77
src/xfns.c
View file

@ -123,10 +123,6 @@ extern LWLIB_ID widget_id_tick;
#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
/* Nonzero if using X. */
int x_in_use;
static Lisp_Object Qsuppress_icon;
static Lisp_Object Qundefined_color;
static Lisp_Object Qcompound_text, Qcancel_timer;
@ -139,38 +135,6 @@ static int dpyinfo_refcount;
static struct x_display_info *x_display_info_for_name (Lisp_Object);
/* Error if we are not connected to X. */
void
check_x (void)
{
if (! x_in_use)
error ("X windows are not in use or not initialized");
}
/* Nonzero if we can use mouse menus.
You should not call this unless HAVE_MENUS is defined. */
int
have_menus_p (void)
{
return x_in_use;
}
/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
and checking validity for X. */
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
if (! FRAME_X_P (f))
error ("Non-X frame used");
return f;
}
/* Let the user specify an X display with a Lisp object.
OBJECT may be nil, a frame or a terminal object.
nil stands for the selected frame--or, if that is not an X frame,
@ -205,7 +169,7 @@ check_x_display_info (Lisp_Object object)
dpyinfo = x_display_info_for_name (object);
else
{
FRAME_PTR f = check_x_frame (object);
FRAME_PTR f = decode_window_system_frame (object);
dpyinfo = FRAME_X_DISPLAY_INFO (f);
}
@ -2992,7 +2956,7 @@ If FRAME is omitted or nil, use the selected frame.
Signal error if FRAME is not an X frame. */)
(Lisp_Object frame)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
block_input ();
x_wm_set_size_hint (f, 0, 0);
@ -3483,7 +3447,7 @@ DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
FRAME nil means use the selected frame. */)
(Lisp_Object frame)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Display *dpy = FRAME_X_DISPLAY (f);
block_input ();
@ -3516,7 +3480,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
(Lisp_Object color, Lisp_Object frame)
{
XColor foo;
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
CHECK_STRING (color);
@ -3531,7 +3495,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
(Lisp_Object color, Lisp_Object frame)
{
XColor foo;
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
CHECK_STRING (color);
@ -3996,7 +3960,6 @@ x_display_info_for_name (Lisp_Object name)
if (dpyinfo == 0)
error ("Cannot connect to X server %s", SDATA (name));
x_in_use = 1;
XSETFASTINT (Vwindow_system_version, 11);
return dpyinfo;
@ -4050,8 +4013,6 @@ An insecure way to solve the problem may be to use `xhost'.\n",
error ("Cannot connect to X server %s", SDATA (display));
}
x_in_use = 1;
XSETFASTINT (Vwindow_system_version, 11);
return Qnil;
}
@ -4143,7 +4104,7 @@ FRAME. Default is to change on the edit X window. */)
(Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Atom prop_atom;
Atom target_type = XA_STRING;
int element_format = 8;
@ -4221,7 +4182,7 @@ DEFUN ("x-delete-window-property", Fx_delete_window_property,
FRAME nil or omitted means use the selected frame. Value is PROP. */)
(Lisp_Object prop, Lisp_Object frame)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Atom prop_atom;
CHECK_STRING (prop);
@ -4257,7 +4218,7 @@ no value of TYPE (always string in the MS Windows case). */)
(Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Atom prop_atom;
int rc;
Lisp_Object prop_value = Qnil;
@ -4525,8 +4486,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
Lisp_Object buffer;
struct buffer *old_buffer;
check_x ();
if (!dpyinfo->terminal->name)
error ("Terminal is not live, can't create new frames on it");
@ -4923,7 +4882,7 @@ Text larger than the specified size is clipped. */)
if (SCHARS (string) == 0)
string = make_unibyte_string (" ", 1);
f = check_x_frame (frame);
f = decode_window_system_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
else
@ -5246,7 +5205,7 @@ DEFUN ("x-uses-old-gtk-dialog", Fx_uses_old_gtk_dialog,
#ifdef USE_GTK
if (use_dialog_box
&& use_file_dialog
&& have_menus_p ()
&& window_system_available (SELECTED_FRAME ())
&& xg_uses_old_file_dialog ())
return Qt;
#endif
@ -5316,7 +5275,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
check_x ();
check_window_system (f);
GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
@ -5486,7 +5445,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
char *cdef_file;
check_x ();
check_window_system (f);
GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
@ -5541,15 +5500,13 @@ FRAME is the frame on which to pop up the font chooser. If omitted or
nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object ignored)
{
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
Lisp_Object font;
Lisp_Object font_param;
char *default_name = NULL;
struct gcpro gcpro1, gcpro2;
ptrdiff_t count = SPECPDL_INDEX ();
check_x ();
if (popup_activated ())
error ("Trying to use a menu from within a menu-entry");
@ -5609,7 +5566,7 @@ present and mapped to the usual X keysyms. */)
return Qlambda;
#else
XkbDescPtr kb;
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
Display *dpy = FRAME_X_DISPLAY (f);
Lisp_Object have_keys;
int major, minor, op, event, error_code;
@ -5737,9 +5694,6 @@ frame_parm_handler x_frame_parm_handlers[] =
void
syms_of_xfns (void)
{
/* This is zero if not using X windows. */
x_in_use = 0;
/* The section below is built by the lisp expression at the top of the file,
just above where these variables are declared. */
/*&&& init symbols here &&&*/
@ -5919,9 +5873,6 @@ When using Gtk+ tooltips, the tooltip face is not used. */);
defsubr (&Sx_focus_frame);
defsubr (&Sx_backspace_delete_keys_p);
/* Setting callback functions for fontset handler. */
check_window_system_func = check_x;
defsubr (&Sx_show_tip);
defsubr (&Sx_hide_tip);
tip_timer = Qnil;

3
src/xgselect.c
View file

@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <glib.h>
#include <errno.h>
#include "xterm.h"
#include "frame.h"
int
xg_select (int fds_lim, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
@ -43,7 +44,7 @@ xg_select (int fds_lim, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
int i, nfds, tmo_in_millisec;
USE_SAFE_ALLOCA;
if (! (x_in_use
if (! (window_system_available (NULL)
&& g_main_context_pending (context = g_main_context_default ())))
return pselect (fds_lim, rfds, wfds, efds, timeout, sigmask);

9
src/xmenu.c
View file

@ -223,8 +223,6 @@ for instance using the window manager, then this produces a quit and
FRAME_PTR f = NULL;
Lisp_Object window;
check_x ();
/* Decode the first argument: find the window or frame to use. */
if (EQ (position, Qt)
|| (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
@ -277,8 +275,7 @@ for instance using the window manager, then this produces a quit and
but I don't want to make one now. */
CHECK_WINDOW (window);
if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f))
error ("Can not put X dialog on this terminal");
check_window_system (f);
/* Force a redisplay before showing the dialog. If a frame is created
just before showing the dialog, its contents may not have been fully
@ -485,7 +482,7 @@ If FRAME is nil or not given, use the selected frame. */)
(Lisp_Object frame)
{
XEvent ev;
FRAME_PTR f = check_x_frame (frame);
FRAME_PTR f = decode_window_system_frame (frame);
Widget menubar;
block_input ();
@ -569,7 +566,7 @@ If FRAME is nil or not given, use the selected frame. */)
block_input (). */
block_input ();
f = check_x_frame (frame);
f = decode_window_system_frame (frame);
if (FRAME_EXTERNAL_MENU_BAR (f))
set_frame_menubar (f, 0, 1);

8
src/xselect.c
View file

@ -2450,7 +2450,7 @@ Use the display for FRAME or the current frame if FRAME is not given or nil.
If the value is 0 or the atom is not known, return the empty string. */)
(Lisp_Object value, Lisp_Object frame)
{
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
char *name = 0;
char empty[] = "";
Lisp_Object ret = Qnil;
@ -2485,7 +2485,7 @@ FRAME is on. If FRAME is nil, the selected frame is used. */)
(Lisp_Object atom, Lisp_Object frame)
{
Atom x_atom;
struct frame *f = check_x_frame (frame);
struct frame *f = decode_window_system_frame (frame);
ptrdiff_t i;
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
@ -2618,7 +2618,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
struct x_display_info *dpyinfo = check_x_display_info (display);
Window wdest;
XEvent event;
struct frame *f = check_x_frame (from);
struct frame *f = decode_window_system_frame (from);
int to_root;
CHECK_NUMBER (format);
@ -2635,7 +2635,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
if (FRAMEP (dest) || NILP (dest))
{
struct frame *fdest = check_x_frame (dest);
struct frame *fdest = decode_window_system_frame (dest);
wdest = FRAME_OUTER_WINDOW (fdest);
}
else if (STRINGP (dest))

6
src/xterm.h
View file

@ -366,10 +366,6 @@ struct x_display_info
extern int use_xim;
#endif
/* This checks to make sure we have a display. */
extern void check_x (void);
extern struct frame *x_window_to_frame (struct x_display_info *, int);
extern struct frame *x_any_window_to_frame (struct x_display_info *, int);
extern struct frame *x_menubar_window_to_frame (struct x_display_info *,
@ -927,7 +923,6 @@ void x_handle_property_notify (XPropertyEvent *);
/* From xfns.c. */
struct frame *check_x_frame (Lisp_Object);
extern void x_free_gcs (struct frame *);
/* From xrdb.c. */
@ -1012,7 +1007,6 @@ extern void x_clipboard_manager_save_all (void);
extern struct x_display_info * check_x_display_info (Lisp_Object);
extern Lisp_Object x_get_focus_frame (struct frame *);
extern int x_in_use;
#ifdef USE_GTK
extern int xg_set_icon (struct frame *, Lisp_Object);

4
test/ChangeLog
View file

@ -1,3 +1,7 @@
2013-04-09 Masatake YAMATO <yamato@redhat.com>
* automated/add-log-tests.el: New file. (Bug#14112)
2013-03-30 Fabián Ezequiel Gallina <fabian@anue.biz>
* automated/python-tests.el (python-indent-block-enders): New test.

84
test/automated/add-log-tests.el Normal file
View file

@ -0,0 +1,84 @@
;;; add-log-tests.el --- Test suite for add-log.
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Masatake YAMATO <yamato@redhat.com>
;; Keywords: vc tools
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; 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/>.
;;; Code:
(require 'add-log)
(defmacro add-log-current-defun-deftest (name doc major-mode
content marker expected-defun)
"Generate an ert test for mode-own `add-log-current-defun-function'.
Run `add-log-current-defun' at the point where MARKER specifies in a
buffer which content is CONTENT under MAJOR-MODE. Then it compares the
result with EXPECTED-DEFUN."
(let ((xname (intern (concat "add-log-current-defun-test-"
(symbol-name name)
))))
`(ert-deftest ,xname ()
,doc
(with-temp-buffer
(insert ,content)
(goto-char (point-min))
(funcall ',major-mode)
(should (equal (when (search-forward ,marker nil t)
(replace-match "" nil t)
(add-log-current-defun))
,expected-defun))))))
(add-log-current-defun-deftest
sh-func1
"Test sh-current-defun-name can find function."
sh-mode "
function foo
{
><
}" "><" "foo")
(add-log-current-defun-deftest
sh-func2
"Test sh-current-defun-name can find function."
sh-mode "
foo()
{
><
}" "><" "foo")
(add-log-current-defun-deftest
sh-func3
"Test sh-current-defun-name can find function."
sh-mode "
function foo()
{
><
}" "><" "foo")
(add-log-current-defun-deftest
sh-var
"Test sh-current-defun-name can find variabe definition."
sh-mode "
PATH=a:/ab:/usr/abc
DIR=/pr><oc"
"><" "DIR")
(provide 'add-log-tests)
;;; add-log-tests.el ends here