procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from mainline.

Browse source
This commit is contained in:
Paul Eggert 2011-02-14 21:41:07 -08:00
commit fae95934b8
131 changed files with 3645 additions and 3444 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
ChangeLog
View file

@ -1,3 +1,23 @@
2011-02-15 Paul Eggert <eggert@cs.ucla.edu>
Merge from gnulib.
2011-02-13 Bruno Haible <bruno@clisp.org>
Consistent macro naming for macros that use GCC __attribute__.
* lib/ignore-value.h (_GL_ATTRIBUTE_DEPRECATED): Renamed from
ATTRIBUTE_DEPRECATED.
2011-02-12 Bruno Haible <bruno@clisp.org>
setlocale: Prefer gnulib's override over libintl's override.
* lib/gettext.h (setlocale): Redefine to rpl_setlocale if
GNULIB_defined_setlocale is set.
2011-02-13 Glenn Morris <rgm@gnu.org>
* make-dist: Exclude generated file src/globals.h.
2011-02-10 Paul Eggert <eggert@cs.ucla.edu>
Import getloadavg module from gnulib.

6
admin/ChangeLog
View file

@ -1,9 +1,13 @@
2011-02-10 Paul Eggert <eggert@cs.ucla.edu>
2011-02-15 Paul Eggert <eggert@cs.ucla.edu>
Remove no-longer needed getloadavg symbols.
* CPP-DEFINES (LOAD_AVE_CVT, LOAD_AVE_TYPE, FSCALE, KERNEL_FILE):
(LDAV_SYMBOL): Remove.
2011-02-12 Glenn Morris <rgm@gnu.org>
* bzrmerge.el (bzrmerge-resolve): Fix bzr revert call.
2011-02-05 Glenn Morris <rgm@gnu.org>
* bzrmerge.el (bzrmerge-warning-buffer): New constant.

4
admin/bzrmerge.el
View file

@ -187,7 +187,9 @@ are both lists of revnos, in oldest-first order."
(cond
((member file '("configure" "lisp/ldefs-boot.el"
"lisp/emacs-lisp/cl-loaddefs.el"))
(call-process "bzr" nil t nil "revert" file)
;; We are in the file's buffer, so names are relative.
(call-process "bzr" nil t nil "revert"
(file-name-nondirectory file))
(revert-buffer nil 'noconfirm))
(t
(goto-char (point-max))

39
admin/notes/bzr
View file

@ -65,11 +65,26 @@ removes a file, then remove the corresponding files by hand.
The following description uses bound branches, presumably it works in
a similar way with unbound ones.
0) (First time only) Get the bzr changelog_merge plugin:
cd ~/.bazaar/plugins
bzr branch lp:bzr-changelog-merge
mv bzr-changelog-merge changelog_merge
This will make merging ChangeLogs a lot smoother. It merges new
entries to the top of the file, rather than trying to fit them in
mid-way through.
1) Get clean, up-to-date copies of the emacs-23 and trunk branches.
Check for any uncommitted changes with bzr status.
2) M-x cd /path/to/trunk
The first time only, do this:
cd .bzr/branch
Add the following line to branch.conf:
changelog_merge_files = ChangeLog
3) load admin/bzrmerge.el
4) M-x bzrmerge RET /path/to/emacs-23 RET
@ -119,3 +134,27 @@ right thing to do is merge everything else, resolve the conflict by
choosing either the trunk or branch version, then run `make -C lisp
autoloads' to update the md5sums to the correct trunk value before
committing.
* Re-adding a file that has been removed from the repository
It's easy to get this wrong. Let's suppose you've done:
bzr remove file; bzr commit
and now, sometime later, you realize this was a mistake and file needs
to be brought back. DON'T just do:
bzr add file; bzr commit
This restores file, but without its history (`bzr log file' will be
very short). This is because file gets re-added with a new file-id
(use `bzr file-id file' to see the id).
Insteading of adding the file, try:
bzr revert -rN file; bzr commit
where revision N+1 is the one where file was removed.
You could also try `bzr add --file-ids-from', if you have a copy of
another branch where file still exists.

5
doc/emacs/ChangeLog
View file

@ -1,3 +1,8 @@
2011-02-14 Jan Djärv <jan.h.d@swipnet.se>
* xresources.texi (X Resources): Remove *faceName and replace it with
*font for Lucid.
2011-02-05 Chong Yidong <cyd@stupidchicken.com>
* rmail.texi (Rmail Display): Document Rmail MIME support more

27
doc/emacs/xresources.texi
View file

@ -428,30 +428,21 @@ and has its own resources. The resource specifications start with
@end iftex
@example
Emacs.pane.menubar.faceName: Courier-12
Emacs.pane.menubar.font: Courier-12
@end example
@noindent
To specify a font, use fontconfig font names as values to the @code{faceName}
resource.
If Emacs is not built with the Xft library, Lucid menus and dialogs
can only display old style fonts. If Emacs is built with Xft and you
prefer the old fonts, you have to specify @samp{none} to
@code{faceName}:
@example
Emacs.pane.menubar.faceName: none
Emacs.pane.dialog.faceName: none
@end example
@noindent
To specify a non-Xft font, use @code{font}. For example:
To specify a font, use fontconfig font names as values to the @code{font}
resource, or old style names:
@example
Emacs.pane.menubar.font: lucidasanstypewriter-10
@end example
@noindent
Emacs first tries to open the font as an old style font, and if that fails
as an fontconfig font. In rare cases, Emacs might do the wrong thing.
@noindent
The Lucid menus can display multilingual text in your locale with old style
fonts. For more information about fontsets see the man page for
@ -480,7 +471,7 @@ Emacs.menu*.font: 8x16
For dialog boxes, use @samp{dialog*}:
@example
Emacs.dialog*.faceName: Sans-12
Emacs.dialog*.font: Sans-12
@end example
@noindent
@ -495,8 +486,6 @@ approach should work on both kinds of systems.
Here is a list of the specific resources for menu bars and pop-up menus:
@table @code
@item faceName
Xft font for menu item text.
@item font
Font for menu item text.
@item fontSet

33
doc/misc/ChangeLog
View file

@ -1,3 +1,36 @@
2011-02-15 Paul Eggert <eggert@cs.ucla.edu>
Merge from gnulib.
* texinfo.tex: Update to version 2011-02-14.11.
2011-02-13 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (History): Remove IMAP support.
(External methods, Frequently Asked Questions): Remove `imap' and
`imaps' methods.
(Password handling): Remove IMAP entries for ~/.authinfo.gpg.
* trampver.texi: Remove default value of `emacsimap'.
2011-02-13 Glenn Morris <rgm@gnu.org>
* ada-mode.texi, dired-x.texi, ebrowse.texi, ediff.texi, eudc.texi:
* idlwave.texi, reftex.texi, sc.texi, speedbar.texi: Add @top.
2011-02-12 Glenn Morris <rgm@gnu.org>
* sc.texi (Getting Connected): Remove old index entries.
2011-02-12 Ulrich Mueller <ulm@gentoo.org>
* url.texi: Remove duplicate @dircategory (Bug#7942).
2011-02-11 Teodor Zlatanov <tzz@lifelogs.com>
* auth.texi (Overview, Help for users, Help for developers):
Update docs.
(Help for users): Talk about spaces.
2011-02-09 Paul Eggert <eggert@cs.ucla.edu>
* texinfo.tex: Update to version 2011-02-07.16.

1
doc/misc/ada-mode.texi
View file

@ -39,6 +39,7 @@ developing GNU and promoting software freedom.''
@contents
@node Top, Overview, (dir), (dir)
@top Ada Mode
@ifnottex
@insertcopying

147
doc/misc/auth.texi
View file

@ -5,7 +5,7 @@
@setfilename ../../info/auth
@settitle Emacs auth-source Library @value{VERSION}
@set VERSION 0.2
@set VERSION 0.3
@copying
This file describes the Emacs auth-source library.
@ -78,15 +78,19 @@ It is a way for multiple applications to share a single configuration
@chapter Overview
The auth-source library is simply a way for Emacs and Gnus, among
others, to answer the old burning question ``I have a server name and
a port, what are my user name and password?''
others, to answer the old burning question ``What are my user name and
password?''
The auth-source library actually supports more than just the user name
(known as the login) or the password, but only those two are in use
today in Emacs or Gnus. Similarly, the auth-source library supports
multiple storage formats, currently either the classic ``netrc''
format, examples of which you can see later in this document, or the
Secret Service API.
(This is different from the old question about burning ``Where is the
fire extinguisher, please?''.)
The auth-source library supports more than just the user name or the
password (known as the secret).
Similarly, the auth-source library supports multiple storage backend,
currently either the classic ``netrc'' backend, examples of which you
can see later in this document, or the Secret Service API. This is
done with EIEIO-based backends and you can write your own if you want.
@node Help for users
@chapter Help for users
@ -96,25 +100,41 @@ Secret Service API.
machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport}
@end example
The machine is the server (either a DNS name or an IP address).
The @code{machine} is the server (either a DNS name or an IP address).
It's known as @var{:host} in @code{auth-source-search} queries. You
can also use @code{host}.
The port is optional. If it's missing, auth-source will assume any
port is OK. Actually the port is a protocol name or a port number so
you can have separate entries for port @var{143} and for protocol
@var{imap} if you fancy that. Anyway, you can just omit the port if
you don't need it.
The @code{port} is the connection port or protocol. It's known as
@var{:port} in @code{auth-source-search} queries. You can also use
@code{protocol}.
The login and password are simply your login credentials to the server.
The @code{user} is the user name. It's known as @var{:user} in
@code{auth-source-search} queries. You can also use @code{login} and
@code{account}.
Spaces are always OK as far as auth-source is concerned (but other
programs may not like them). Just put the data in quotes, escaping
quotes as you'd expect with @code{\}.
All these are optional. You could just say (but we don't recommend
it, we're just showing that it's possible)
@example
password @var{mypassword}
@end example
to use the same password everywhere. Again, @emph{DO NOT DO THIS} or
you will be pwned as the kids say.
``Netrc'' files are usually called @code{.authinfo} or @code{.netrc};
nowadays @code{.authinfo} seems to be more popular and the auth-source
library encourages this confusion by making it the default, as you'll
see later.
If you have problems with the port, set @code{auth-source-debug} to
@code{t} and see what port the library is checking in the
@code{*Messages*} buffer. Ditto for any other problems, your first
step is always to see what's being checked. The second step, of
If you have problems with the search, set @code{auth-source-debug} to
@code{t} and see what host, port, and user the library is checking in
the @code{*Messages*} buffer. Ditto for any other problems, your
first step is always to see what's being checked. The second step, of
course, is to write a blog entry about it and wait for the answer in
the comments.
@ -139,56 +159,36 @@ and simplest configuration is:
(setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
;;; mostly equivalent (see below about fallbacks) but shorter:
(setq auth-sources '((:source "~/.authinfo.gpg")))
;;; even shorter and the @emph{default}:
(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo"))
;;; use the Secrets API @var{login} collection (@pxref{Secret Service API})
(setq auth-sources '("secrets:login"))
@end lisp
This says ``for any host and any protocol, use just that one file.''
Sweet simplicity. In fact, the latter is already the default, so
unless you want to move your netrc file, it will just work if you have
that file. Make sure it exists.
By adding multiple entries to @code{auth-sources} with a particular
host or protocol, you can have specific netrc files for that host or
protocol. Usually this is unnecessary but may make sense if you have
shared netrc files or some other unusual setup (90% of Emacs users
have unusual setups and the remaining 10% are @emph{really} unusual).
Here's an example that uses the Secret Service API for all lookups,
using the default collection:
@lisp
(setq auth-sources '((:source (:secrets default))))
@end lisp
And here's a mixed example, using two sources:
Here's a mixed example using two sources:
@lisp
(setq auth-sources '((:source (:secrets default) :host "myserver" :user "joe")
(:source "~/.authinfo.gpg")))
"~/.authinfo.gpg"))
@end lisp
The best match is determined by order (starts from the bottom) only
for the first pass, where things are checked exactly. In the example
above, the first pass would find a single match for host
@code{myserver}. The netrc choice would fail because it matches any
host and protocol implicitly (as a @emph{fallback}). A specified
value of @code{:host t} in @code{auth-sources} is considered a match
on the first pass, unlike a missing @code{:host}.
Now if you look for host @code{missing}, it won't match either source
explicitly. The second pass (the @emph{fallback} pass) will look at
all the implicit matches and collect them. They will be scored and
returned sorted by score. The score is based on the number of
explicit parameters that matched. See the @code{auth-pick} function
for details.
@end defvar
If you don't customize @code{auth-sources}, you'll have to live with
the defaults: any host and any port are looked up in the netrc
file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file
(@pxref{GnuPG and EasyPG Assistant Configuration}).
(@pxref{GnuPG and EasyPG Assistant Configuration}).
The simplest working netrc line example is one without a port.
If that fails, the unencrypted netrc file @code{~/.authinfo} will
be used.
The typical netrc line example is without a port.
@example
machine YOURMACHINE login YOU password YOURPASSWORD
@ -233,42 +233,29 @@ TODO: how does it work generally, how does secrets.el work, some examples.
@node Help for developers
@chapter Help for developers
The auth-source library only has one function for external use.
The auth-source library only has a few functions for external use.
@defun auth-source-user-or-password mode host port &optional username
@defun auth-source-search SPEC
Retrieve appropriate authentication tokens, determined by @var{mode},
for host @var{host} and @var{port}. If @var{username} is provided it
will also be checked. If @code{auth-source-debug} is t, debugging
messages will be printed. Set @code{auth-source-debug} to a function
to use that function for logging. The parameters passed will be the
same that the @code{message} function takes, that is, a string
formatting spec and optional parameters.
TODO: how to include docstring?
If @var{mode} is a list of strings, the function will return a list of
strings or @code{nil} objects (thus you can avoid parsing the netrc
file or checking the Secret Service API more than once). If it's a
string, the function will return a string or a @code{nil} object.
Currently only the modes ``login'' and ``password'' are recognized but
more may be added in the future.
@end defun
@var{host} is a string containing the host name.
@defun auth-source-delete SPEC
@var{port} contains the protocol name (e.g. ``imap'') or
a port number. It must be a string, corresponding to the port in the
users' netrc files.
TODO: how to include docstring?
@var{username} contains the user name (e.g. ``joe'') as a string.
@end defun
@example
;; IMAP example
(setq auth (auth-source-user-or-password
'("login" "password")
"anyhostnamehere"
"imap"))
(nth 0 auth) ; the login name
(nth 1 auth) ; the password
@end example
@defun auth-source-forget SPEC
TODO: how to include docstring?
@end defun
@defun auth-source-forget+ SPEC
TODO: how to include docstring?
@end defun

1
doc/misc/dired-x.texi
View file

@ -69,6 +69,7 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top
@top Dired Extra
@comment node-name, next, previous, up
@noindent

1
doc/misc/ebrowse.texi
View file

@ -46,6 +46,7 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top, Overview, (dir), (dir)
@top Ebrowse
You can browse C++ class hierarchies from within Emacs by using
Ebrowse.

2
doc/misc/ediff.texi
View file

@ -63,6 +63,7 @@ developing GNU and promoting software freedom.''
@contents
@node Top, Introduction, (dir), (dir)
@top Ediff
@insertcopying
@ -2540,4 +2541,3 @@ Eli Zaretskii (eliz at is.elta.co.il)
@printindex cp
@bye

1
doc/misc/eudc.texi
View file

@ -50,6 +50,7 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top, Overview, (dir), (dir)
@top Emacs Unified Directory Client
@comment node-name, next, previous, up
@insertcopying

1
doc/misc/idlwave.texi
View file

@ -57,6 +57,7 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top, Introduction, (dir), (dir)
@top IDLWAVE
IDLWAVE is a package which supports editing source code written in the
Interactive Data Language (IDL), and running IDL as an inferior shell.

1
doc/misc/reftex.texi
View file

@ -79,6 +79,7 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top,,,(dir)
@top RefTeX
@b{Ref@TeX{}} is a package for managing Labels, References,
Citations and index entries with GNU Emacs.

3
doc/misc/sc.texi
View file

@ -53,6 +53,7 @@ developing GNU and promoting software freedom.''
@ifnottex
@node Top, Introduction, (dir), (dir)
@top Supercite
@comment node-name, next, previous, up
@insertcopying
@ -751,8 +752,6 @@ interface specifications, or if you are writing or maintaining an MUA,
@cindex .emacs file
@findex sc-cite-original
@findex cite-original (sc-)
@findex sc-submit-bug-report
@findex submit-bug-report (sc-)
The first thing that everyone should do, regardless of the MUA you are
using is to set up Emacs so it will load Supercite at the appropriate
time. This happens automatically if Supercite is distributed with your

1
doc/misc/speedbar.texi
View file

@ -40,6 +40,7 @@ developing GNU and promoting software freedom.''
@node Top, , , (dir)Top
@comment node-name, next, previous, up
@top Speedbar
Speedbar is a program for Emacs which can be used to summarize
information related to the current buffer. Its original inspiration

316
doc/misc/texinfo.tex
View file

@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
\def\texinfoversion{2011-02-07.16}
\def\texinfoversion{2011-02-14.11}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@ -158,6 +158,7 @@
\def\spaceisspace{\catcode`\ =\spacecat}
% sometimes characters are active, so we need control sequences.
\chardef\ampChar = `\&
\chardef\colonChar = `\:
\chardef\commaChar = `\,
\chardef\dashChar = `\-
@ -547,7 +548,7 @@
}
\def\inenvironment#1{%
\ifx#1\empty
out of any environment%
outside of any environment%
\else
in environment \expandafter\string#1%
\fi
@ -2491,22 +2492,8 @@
\codex
}
}
% Handle @url similarly to \code, but allows line breaks after .#?/ (only).
{
\catcode`\.=\active \catcode`\#=\active
\catcode`\?=\active \catcode`\/=\active
%
\global\def\urefcode{\begingroup
\setupmarkupstyle{code}%
\catcode\dotChar=\active \catcode\hashChar=\active
\catcode\questChar=\active \catcode\slashChar=\active
\let.\urefcodedot
\let#\urefcodehash
\let?\urefcodequestion
\let/\urefcodeslash
\codex
}
}
\def\codex #1{\tclose{#1}\endgroup}
\def\realdash{-}
\def\codedash{-\discretionary{}{}{}}
@ -2521,25 +2508,6 @@
\discretionary{}{}{}}%
{\_}%
}
% we put a little stretch before and after the breakable chars, to help
% line breaking of long url's. The unequal skips make look better in
% cmtt at least, especially for dots.
\def\urefprestretch{\nobreak \hskip0pt plus.13em }
\def\urefpoststretch{\allowbreak \hskip0pt plus.1em }
\def\urefcodedot{\urefprestretch .\urefpoststretch}
\def\urefcodehash{\urefprestretch \#\urefpoststretch}
\def\urefcodequestion{\urefprestretch ?\urefpoststretch}
\def\urefcodeslash{\futurelet\next\urefcodeslashfinish}
{
\catcode`\/=\active
\global\def\urefcodeslashfinish{%
\urefprestretch \slashChar
% Allow line break only after the final / in a sequence of
% slashes, to avoid line break between the slashes in http://.
\ifx\next/\else \urefpoststretch \fi
}
}
\def\codex #1{\tclose{#1}\endgroup}
% An additional complication: the above will allow breaks after, e.g.,
% each of the four underscores in __typeof__. This is undesirable in
@ -2563,6 +2531,152 @@
\fi\fi
}
% @uref (abbreviation for `urlref') takes an optional (comma-separated)
% second argument specifying the text to display and an optional third
% arg as text to display instead of (rather than in addition to) the url
% itself. First (mandatory) arg is the url.
% (This \urefnobreak definition isn't used now, leaving it for a while
% for comparison.)
\def\urefnobreak#1{\dourefnobreak #1,,,\finish}
\def\dourefnobreak#1,#2,#3,#4\finish{\begingroup
\unsepspaces
\pdfurl{#1}%
\setbox0 = \hbox{\ignorespaces #3}%
\ifdim\wd0 > 0pt
\unhbox0 % third arg given, show only that
\else
\setbox0 = \hbox{\ignorespaces #2}%
\ifdim\wd0 > 0pt
\ifpdf
\unhbox0 % PDF: 2nd arg given, show only it
\else
\unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url
\fi
\else
\code{#1}% only url given, so show it
\fi
\fi
\endlink
\endgroup}
% This \urefbreak definition is the active one.
\def\urefbreak{\begingroup \urefcatcodes \dourefbreak}
\let\uref=\urefbreak
\def\dourefbreak#1{\urefbreakfinish #1,,,\finish}
\def\urefbreakfinish#1,#2,#3,#4\finish{% doesn't work in @example
\unsepspaces
\pdfurl{#1}%
\setbox0 = \hbox{\ignorespaces #3}%
\ifdim\wd0 > 0pt
\unhbox0 % third arg given, show only that
\else
\setbox0 = \hbox{\ignorespaces #2}%
\ifdim\wd0 > 0pt
\ifpdf
\unhbox0 % PDF: 2nd arg given, show only it
\else
\unhbox0\ (\urefcode{#1})% DVI: 2nd arg given, show both it and url
\fi
\else
\urefcode{#1}% only url given, so show it
\fi
\fi
\endlink
\endgroup}
% Allow line breaks around only a few characters (only).
\def\urefcatcodes{%
\catcode\ampChar=\active \catcode\dotChar=\active
\catcode\hashChar=\active \catcode\questChar=\active
\catcode\slashChar=\active
}
{
\urefcatcodes
%
\global\def\urefcode{\begingroup
\setupmarkupstyle{code}%
\urefcatcodes
\let&\urefcodeamp
\let.\urefcodedot
\let#\urefcodehash
\let?\urefcodequest
\let/\urefcodeslash
\codex
}
%
% By default, they are just regular characters.
\global\def&{\normalamp}
\global\def.{\normaldot}
\global\def#{\normalhash}
\global\def?{\normalquest}
\global\def/{\normalslash}
}
% we put a little stretch before and after the breakable chars, to help
% line breaking of long url's. The unequal skips make look better in
% cmtt at least, especially for dots.
\def\urefprestretch{\urefprebreak \hskip0pt plus.13em }
\def\urefpoststretch{\urefpostbreak \hskip0pt plus.1em }
%
\def\urefcodeamp{\urefprestretch \&\urefpoststretch}
\def\urefcodedot{\urefprestretch .\urefpoststretch}
\def\urefcodehash{\urefprestretch \#\urefpoststretch}
\def\urefcodequest{\urefprestretch ?\urefpoststretch}
\def\urefcodeslash{\futurelet\next\urefcodeslashfinish}
{
\catcode`\/=\active
\global\def\urefcodeslashfinish{%
\urefprestretch \slashChar
% Allow line break only after the final / in a sequence of
% slashes, to avoid line break between the slashes in http://.
\ifx\next/\else \urefpoststretch \fi
}
}
% One more complication: by default we'll break after the special
% characters, but some people like to break before the special chars, so
% allow that. Also allow no breaking at all, for manual control.
%
\parseargdef\urefbreakstyle{%
\def\txiarg{#1}%
\ifx\txiarg\wordnone
\def\urefprebreak{\nobreak}\def\urefpostbreak{\nobreak}
\else\ifx\txiarg\wordbefore
\def\urefprebreak{\allowbreak}\def\urefpostbreak{\nobreak}
\else\ifx\txiarg\wordafter
\def\urefprebreak{\nobreak}\def\urefpostbreak{\allowbreak}
\else
\errhelp = \EMsimple
\errmessage{Unknown @urefbreakstyle setting `\txiarg'}%
\fi\fi\fi
}
\def\wordafter{after}
\def\wordbefore{before}
\def\wordnone{none}
\urefbreakstyle after
% @url synonym for @uref, since that's how everyone uses it.
%
\let\url=\uref
% rms does not like angle brackets --karl, 17may97.
% So now @email is just like @uref, unless we are pdf.
%
%\def\email#1{\angleleft{\tt #1}\angleright}
\ifpdf
\def\email#1{\doemail#1,,\finish}
\def\doemail#1,#2,#3\finish{\begingroup
\unsepspaces
\pdfurl{mailto:#1}%
\setbox0 = \hbox{\ignorespaces #2}%
\ifdim\wd0>0pt\unhbox0\else\code{#1}\fi
\endlink
\endgroup}
\else
\let\email=\uref
\fi
% @kbd is like @code, except that if the argument is just one @key command,
% then @kbd has no effect.
\def\kbd#1{{\setupmarkupstyle{kbd}\def\look{#1}\expandafter\kbdfoo\look??\par}}
@ -2580,7 +2694,7 @@
\gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}%
\else
\errhelp = \EMsimple
\errmessage{Unknown @kbdinputstyle option `\txiarg'}%
\errmessage{Unknown @kbdinputstyle setting `\txiarg'}%
\fi\fi\fi
}
\def\worddistinct{distinct}
@ -2608,79 +2722,6 @@
\parseargdef\clickstyle{\def\click{#1}}
\def\click{\arrow}
% @uref (abbreviation for `urlref') takes an optional (comma-separated)
% second argument specifying the text to display and an optional third
% arg as text to display instead of (rather than in addition to) the url
% itself. First (mandatory) arg is the url. Perhaps eventually put in
% a hypertex \special here.
%
\def\uref#1{\douref #1,,,\finish}
\def\douref#1,#2,#3,#4\finish{\begingroup
\unsepspaces
\pdfurl{#1}%
\setbox0 = \hbox{\ignorespaces #3}%
\ifdim\wd0 > 0pt
\unhbox0 % third arg given, show only that
\else
\setbox0 = \hbox{\ignorespaces #2}%
\ifdim\wd0 > 0pt
\ifpdf
\unhbox0 % PDF: 2nd arg given, show only it
\else
\unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url
\fi
\else
\code{#1}% only url given, so show it
\fi
\fi
\endlink
\endgroup}
\def\nouref#1,#2,#3,#4\finish{\begingroup % doesn't work in @example
\unsepspaces
\pdfurl{#1}%
\setbox0 = \hbox{\ignorespaces #3}%
\ifdim\wd0 > 0pt
\unhbox0 % third arg given, show only that
\else
\setbox0 = \hbox{\ignorespaces #2}%
\ifdim\wd0 > 0pt
\ifpdf
\unhbox0 % PDF: 2nd arg given, show only it
\else
% \empty at the end of \scantokens arg gets rid of
% trailing newline (and ultimate spurious whitespace).
\unhbox0\ (\urefcode{\scantokens{#1\empty}})% DVI: 2nd arg given,
% show both it and url
\fi
\else
\urefcode{\scantokens{#1\empty}}% only url given, so show it
\fi
\fi
\endlink
\endgroup}
% @url synonym for @uref, since that's how everyone uses it.
%
\let\url=\uref
% rms does not like angle brackets --karl, 17may97.
% So now @email is just like @uref, unless we are pdf.
%
%\def\email#1{\angleleft{\tt #1}\angleright}
\ifpdf
\def\email#1{\doemail#1,,\finish}
\def\doemail#1,#2,#3\finish{\begingroup
\unsepspaces
\pdfurl{mailto:#1}%
\setbox0 = \hbox{\ignorespaces #2}%
\ifdim\wd0>0pt\unhbox0\else\code{#1}\fi
\endlink
\endgroup}
\else
\let\email=\uref
\fi
% Typeset a dimension, e.g., `in' or `pt'. The only reason for the
% argument is to make the input look right: @dmn{pt} instead of @dmn{}pt.
%
@ -5677,6 +5718,8 @@
%
\def\sectionheading#1#2#3#4{%
{%
\checkenv{}% should not be in an environment.
%
% Switch to the right set of fonts.
\csname #2fonts\endcsname \rmisbold
%
@ -9305,24 +9348,15 @@
\catcode`\^^? = 14
% Define macros to output various characters with catcode for normal text.
\catcode`\"=\other
\catcode`\~=\other
\catcode`\^=\other
\catcode`\_=\other
\catcode`\|=\other
\catcode`\<=\other
\catcode`\>=\other
\catcode`\+=\other
\catcode`\$=\other
\def\normaldoublequote{"}
\def\normaltilde{~}
\def\normalcaret{^}
\def\normalunderscore{_}
\def\normalverticalbar{|}
\def\normalless{<}
\def\normalgreater{>}
\def\normalplus{+}
\def\normaldollar{$}%$ font-lock fix
\catcode`\"=\other \def\normaldoublequote{"}
\catcode`\$=\other \def\normaldollar{$}%$ font-lock fix
\catcode`\+=\other \def\normalplus{+}
\catcode`\<=\other \def\normalless{<}
\catcode`\>=\other \def\normalgreater{>}
\catcode`\^=\other \def\normalcaret{^}
\catcode`\_=\other \def\normalunderscore{_}
\catcode`\|=\other \def\normalverticalbar{|}
\catcode`\~=\other \def\normaltilde{~}
% This macro is used to make a character print one way in \tt
% (where it can probably be output as-is), and another way in other fonts,
@ -9415,16 +9449,16 @@
% the literal character `\'.
%
@def@normalturnoffactive{%
@let\=@normalbackslash
@let"=@normaldoublequote
@let~=@normaltilde
@let$=@normaldollar %$ font-lock fix
@let+=@normalplus
@let<=@normalless
@let>=@normalgreater
@let\=@normalbackslash
@let^=@normalcaret
@let_=@normalunderscore
@let|=@normalverticalbar
@let<=@normalless
@let>=@normalgreater
@let+=@normalplus
@let$=@normaldollar %$ font-lock fix
@let~=@normaltilde
@markupsetuplqdefault
@markupsetuprqdefault
@unsepspaces
@ -9456,10 +9490,16 @@
% Say @foo, not \foo, in error messages.
@escapechar = `@@
% These (along with & and #) are made active for url-breaking, so need
% active definitions as the normal characters.
@def@normaldot{.}
@def@normalquest{?}
@def@normalslash{/}
% These look ok in all fonts, so just make them not special.
@catcode`@& = @other
@catcode`@# = @other
@catcode`@% = @other
@catcode`@& = @other @def@normalamp{&}
@catcode`@# = @other @def@normalhash{#}
@catcode`@% = @other @def@normalpercent{%}
@c Finally, make ` and ' active, so that txicodequoteundirected and
@c txicodequotebacktick work right in, e.g., @w{@code{`foo'}}. If we

44
doc/misc/tramp.texi
View file

@ -443,9 +443,6 @@ Support of gateways exists since April 2007.
@ifset emacsgvfs
GVFS integration started in February 2009.
@end ifset
@ifset emacsimap
Storing files into IMAP mailboxes has been added in September 2009.
@end ifset
In December 2001, @value{tramp} has been added to the XEmacs package
repository. Being part of the GNU Emacs repository happened in June
@ -1012,29 +1009,6 @@ Windows, this method isn't available. Instead, you can use UNC
file names like @file{//melancholia/daniel$$/.emacs}. The only
disadvantage is that there's no possibility to specify another user
name.
@ifset emacsimap
@item @option{imap}
@cindex method imap
@cindex method imaps
@cindex imap method
@cindex imaps method
Accessing an IMAP mailbox is intended to save files there as encrypted
messages. It could be used in case there are no other remote file
storages available.
@value{tramp} supports both @option{imap} and @option{imaps} methods.
The latter one accesses the IMAP server over ssl.
Both methods support the port number specification.
Note that special handling is needed for declaring a passphrase for
encryption / decryption of the messages (@pxref{Using an
authentication file}).
@end ifset
@end table
@ -1625,18 +1599,6 @@ The port can be any @value{tramp} method (@pxref{Inline methods},
@pxref{External methods}), to match only this method. When you omit
the port, you match all @value{tramp} methods.
@ifset emacsimap
A special case are @option{imap}-like methods. Authentication with
the IMAP server is performed via @file{imap.el}, there is no special
need from @value{tramp} point of view. An additional passphrase, used
for symmetric encryption and decryption of the stored messages, should
be given with the special port indication @option{tramp-imap}:
@example
machine melancholia port tramp-imap login daniel password ultrageheim
@end example
@end ifset
@anchor{Caching passwords}
@subsection Caching passwords
@ -2782,9 +2744,9 @@ The package has been used successfully on GNU Emacs 22, GNU Emacs 23,
XEmacs 21 (starting with 21.4), and SXEmacs 22.
The package was intended to work on Unix, and it really expects a
Unix-like system on the remote end (except the @option{smb} and
@option{imap} methods), but some people seemed to have some success
getting it to work on MS Windows XP/Vista/7 @value{emacsname}.
Unix-like system on the remote end (except the @option{smb} method),
but some people seemed to have some success getting it to work on MS
Windows XP/Vista/7 @value{emacsname}.
@item

5
doc/misc/trampver.texi
View file

@ -28,11 +28,6 @@
@set emacsgw
@end ifclear
@c Whether or not describe IMAP support.
@ifclear noemacsimap
@set emacsimap
@end ifclear
@c Some flags which make the text independent on the (X)Emacs flavor.
@c "emacs" resp "xemacs" are set in the Makefile. Default is "emacs".
@ifclear emacs

1
doc/misc/url.texi
View file

@ -12,7 +12,6 @@
\overfullrule=0pt
%\global\baselineskip 30pt % for printing in double space
@end tex
@dircategory World Wide Web
@dircategory Emacs
@direntry
* URL: (url). URL loading package.

10
etc/ChangeLog
View file

@ -1,3 +1,11 @@
2011-02-13 Michael Albinus <michael.albinus@gmx.de>
* NEWS: Tramp methods "imap" and "imaps" are discontinued.
2011-02-12 Drew Adams <drew.adams@oracle.com>
* themes/light-blue-theme.el: New file.
2011-02-01 Paul Eggert <eggert@cs.ucla.edu>
format-time-string now supports subsecond time stamp resolution
@ -382,7 +390,7 @@
* srecode/doc-default.srt (section-comment, function-comment)
(variable-same-line-comment, group-comment-start, group-comment-end):
* srecode/doc-java.srt (function-comment, variable-same-line-comment)
(group-comment-start, gropu-comment-end):
(group-comment-start, group-comment-end):
Fix typos in template docstrings.
2010-01-14 Kenichi Handa <handa@m17n.org>

19
etc/NEWS
View file

@ -137,9 +137,8 @@ theme when Emacs is built with GTK.
off by customizing x-gtk-use-system-tooltips.
** Lucid menus and dialogs can display antialiased fonts if Emacs is built
with Xft. To change font, use X resource faceName, for example:
Emacs.pane.menubar.faceName: Courier-12
Set faceName to none and use font to use the old X fonts.
with Xft. To change font, use the X resource font, for example:
Emacs.pane.menubar.font: Courier-12
+++
** Enhanced support for characters that have no glyphs in available fonts
@ -588,7 +587,7 @@ on a D-Bus without simultaneously registering a property or a method.
*** There exists a new inline access method "ksu" (kerberized su).
*** The following access methods are discontinued: "ssh1_old",
"ssh2_old", "scp1_old", "scp2_old" and "fish".
"ssh2_old", "scp1_old", "scp2_old", "imap", "imaps" and "fish".
** VC and related modes
@ -606,7 +605,17 @@ The vc-merge command now runs a "merge" operation, if it is supported.
This merges another branch into the current one. This command prompts
the user for specifics, e.g. a merge source.
**** Currently supported by Bzr, Git, and Mercurial.
**** Currently supported for Bzr, Git, and Mercurial.
*** Log entries in some Log View buffers can be toggled to display a
longer description by typing RET (log-view-toggle-entry-display).
In the Log View buffers made by `C-x v L' (vc-print-root-log), you can
use this to display the full log entry for the revision at point.
**** Currently supported for Bzr, Git, and Mercurial.
**** Packages using Log View mode can enable this functionality by
binding `log-view-expanded-log-entry-function' to a suitable function.
** Miscellaneous

67
etc/themes/light-blue-theme.el Normal file
View file

@ -0,0 +1,67 @@
;;; light-blue-theme.el --- Custom theme for faces
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Drew Adams <drew.adams@oracle.com>
;; 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/>.
;;; Commentary:
;; Extracted from the settings in oneonone.el by Drew Adams.
;;; Code:
(deftheme light-blue
"Theme with a light blue backgound.")
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
'light-blue
`(default ((,class (:background "LightBlue" :foreground "black"))))
`(cursor ((,class (:background "red"))))
`(fringe ((,class (:background "gray85"))))
;; Highlighting faces
`(highlight ((,class (:background "cyan"))))
`(region ((,class (:background "MediumAquamarine"))))
`(secondary-selection ((,class (:background "white" :foreground "black"))))
`(isearch ((,class (:background "green" :foreground "Black"))))
`(lazy-highlight ((,class (:background "dark turquoise"))))
`(query-replace ((,class (:inherit isearch :background "white" :foreground "black"))))
`(match ((,class (:background "SkyBlue"))))
;; Mode line faces
`(mode-line ((,class (:background "PaleGoldenrod" :foreground "black" :box (:line-width -1 :style released-button)))))
`(mode-line-buffer-id ((,class (:overline "red" :underline "red"))))
`(mode-line-inactive ((,class (:inherit mode-line :background "LightGray" :foreground "grey20" :box (:line-width -1 :color "grey75") :weight light))))
;; Escape and prompt faces
`(escape-glyph ((,class (:background "gold" :foreground "blue" :box (:line-width 1 :color "blue" :style released-button)))))
;; Font lock faces
`(font-lock-builtin-face ((,class (:foreground "#b35caf"))))
`(font-lock-constant-face ((,class (:foreground "#00006DE06DE0"))))
`(font-lock-function-name-face ((,class (:foreground "red"))))
`(font-lock-keyword-face ((,class (:foreground "Blue3"))))
`(font-lock-string-face ((,class (:foreground "Magenta4"))))
`(font-lock-warning-face ((,class (:foreground "orange red" :weight bold))))
;; Compilation faces
`(next-error ((,class (:inherit region :background "SkyBlue"))))))
(provide-theme 'light-blue)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; light-blue-theme.el ends here

1
lib-src/.gitignore vendored
View file

@ -1,6 +1,5 @@
DOC
ctags.c
getopt.h
stamp_BLD
echolisp.tmp

6
lib/gettext.h
View file

@ -93,6 +93,12 @@
#endif
/* Prefer gnulib's setlocale override over libintl's setlocale override. */
#ifdef GNULIB_defined_setlocale
# undef setlocale
# define setlocale rpl_setlocale
#endif
/* A pseudo function call that serves as a marker for the automated
extraction of messages, but does not call gettext(). The run-time
translation is done at a different place in the code.

8
lib/ignore-value.h
View file

@ -35,13 +35,13 @@
#ifndef _GL_IGNORE_VALUE_H
# define _GL_IGNORE_VALUE_H
# ifndef ATTRIBUTE_DEPRECATED
# ifndef _GL_ATTRIBUTE_DEPRECATED
/* The __attribute__((__deprecated__)) feature
is available in gcc versions 3.1 and newer. */
# if __GNUC__ < 3 || (__GNUC__ == 3 && __GNUC_MINOR__ < 1)
# define ATTRIBUTE_DEPRECATED /* empty */
# define _GL_ATTRIBUTE_DEPRECATED /* empty */
# else
# define ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
# endif
# endif
@ -56,7 +56,7 @@
/* ignore_value works for scalars, pointers and aggregates;
deprecate ignore_ptr. */
static inline void ATTRIBUTE_DEPRECATED
static inline void _GL_ATTRIBUTE_DEPRECATED
ignore_ptr (void *p) { (void) p; } /* deprecated: use ignore_value */
#endif

153
lisp/ChangeLog
View file

@ -1,3 +1,111 @@
2011-02-14 Chong Yidong <cyd@stupidchicken.com>
* vc/vc-git.el (vc-git-root-log-format): New option for
customizing log format.
(vc-git-print-log, vc-git-log-outgoing, vc-git-log-incoming)
(vc-git-log-view-mode): Use it.
(vc-git-expanded-log-entry): New function.
(vc-git-log-view-mode): Use it. Truncate lines in root log.
* vc/vc-hg.el (vc-hg-root-log-template): New option for
customizing log format.
(vc-hg-print-log): Use it.
(vc-hg-expanded-log-entry): New function.
(vc-hg-log-view-mode): Use vc-hg-root-log-template and
vc-hg-expanded-log-entry. Truncate lines in root log.
* vc/vc-bzr.el (vc-bzr-log-view-mode): Truncate lines in root log.
* vc/log-view.el (log-view-mode-menu): Add
log-view-toggle-entry-display.
2011-02-14 Glenn Morris <rgm@gnu.org>
* dired-x.el: Don't require man when compiling.
(dired-omit-extensions, dired-local-variables-file)
(dired-x-hands-off-my-keys): Make them defcustoms.
(Man-support-local-filenames, Man-getpage-in-background): Declare.
(vm-visit-folder): Declare rather than defining.
(dired-x-help-address, dired-x-variable-list): Remove.
(dired-x-submit-report): Make it an obsolete alias.
2011-02-14 Juanma Barranquero <lekktu@gmail.com>
* makefile.w32-in (TRAMP_SRC): Remove tramp-imap.el.
2011-02-13 Teodor Zlatanov <tzz@lifelogs.com>
* net/imap.el: Bring it back.
2011-02-13 Alan Mackenzie <acm@muc.de>
* progmodes/cc-fonts.el (c-font-lock-declarations): Remove a
narrow-to-region call that cuts context off the end (Bug#7722).
* progmodes/cc-engine.el (c-forward-<>-arglist-recur): Refactor
nested if-forms with a simple cond.
(c-forward-<>-arglist): Revert 2011-01-31 change.
2011-02-13 Chong Yidong <cyd@stupidchicken.com>
* vc/log-view.el: New command log-view-toggle-entry-display for
toggling log entries between concise and detailed forms.
(log-view-toggle-entry-display): New command.
(log-view-mode-map): Bind RET to it.
(log-view-expanded-log-entry-function): New variable.
(log-view-current-entry, log-view-inside-comment-p)
(log-view-current-tag): New functions.
(log-view-toggle-mark-entry): Use log-view-current-entry and
log-view-end-of-defun instead of searching directly with
log-view-message-re.
(log-view-end-of-defun): Likewise. Add optional ARG for
compatibility with end-of-defun.
(log-view-end-of-defun): Ignore comments and VC buttons.
* vc/vc-bzr.el (vc-bzr-expanded-log-entry): New function.
(vc-bzr-log-view-mode): Use log-view-expanded-log-entry-function.
2011-02-13 Teodor Zlatanov <tzz@lifelogs.com>
* net/imap.el: Remove file. All the functionality is in nnimap.el.
* net/imap-hash.el: Remove file.
2011-02-13 Michael Albinus <michael.albinus@gmx.de>
* Makefile.in (TRAMP_SRC): Remove tramp-imap.el.
* net/tramp.el (tramp-read-passwd): Simplify `auth-source-search'
call.
* net/tramp-imap.el: Remove file.
2011-02-13 Chong Yidong <cyd@stupidchicken.com>
* vc/vc.el (vc-print-log-setup-buttons): Instead of using the
widget library for buttons, just use button.el.
* vc/log-view.el (log-view-mode-map): Don't inherit from
widget-keymap.
2011-02-12 Glenn Morris <rgm@gnu.org>
* emacs-lisp/cl-seq.el (union, nunion, intersection)
(nintersection, set-difference, nset-difference)
(set-exclusive-or, nset-exclusive-or): Doc fix.
* ediff-ptch.el (ediff-fixup-patch-map): Doc fix.
* faces.el (face-attr-match-p): Handle the obsolete :bold and
:italic props, so that frame-set-background-mode works. (Bug#7966)
* simple.el (next-error): Doc fix.
2011-02-12 Thierry Volpiatto <thierry.volpiatto@gmail.com>
* dired-aux.el (dired-create-files): Adapt destination name to
match the new behavior of copy-directory.
2011-02-12 Chong Yidong <cyd@stupidchicken.com>
* mail/mail-utils.el (mail-dont-reply-to-names): New variable,
@ -169,6 +277,11 @@
(allout-after-copy-or-kill-hook): No arguments - hook implementers
should concentrate on the kill ring.
2011-02-09 Teodor Zlatanov <tzz@lifelogs.com>
* password-cache.el (password-cache-remove): Accept secrets that are
not strings.
2011-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case
@ -507,7 +620,7 @@
2011-01-31 Deniz Dogan <deniz.a.m.dogan@gmail.com>
* net/rcirc.el: New customizable nick completion format. (Bug#6314)
* net/rcirc.el: New customizable nick completion format. (Bug#6314)
(rcirc-nick-completion-format): New defcustom.
(rcirc-complete): Use it.
@ -812,7 +925,7 @@
* calc/calc.el (calc-default-power-reference-level)
(calc-default-field-reference-level): New variables.
* calc/calc-units.el (math-standard-units): Add dB and Np.
* calc/calc-units.el (math-standard-units): Add dB and Np.
(math-logunits): New variable.
(math-extract-logunits, math-logcombine, calcFunc-luplus)
(calcFunc-luminus, calc-luplus, calc-luminus, math-logunit-level)
@ -822,7 +935,7 @@
* calc/calc-help.el (calc-u-prefix-help): Add logarithmic help.
(calc-ul-prefix-help): New function.
* calc/calc-ext.el (calc-init-extensions): Autoload new units
functions. Add keybindings for new units functions.
functions. Add keybindings for new units functions.
2011-01-22 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
@ -928,7 +1041,7 @@
2011-01-20 Ken Manheimer <ken.manheimer@gmail.com>
* allout.el: (allout-institute-keymap): Use fset instead of
* allout.el (allout-institute-keymap): Use fset instead of
reapplying defalias.
(allout-hotspot-key-handler): Check for non-control-modified
@ -1056,7 +1169,7 @@
(info-xref-output-heading): Rename from info-xref-filename-heading.
(info-xref-good, info-xref-bad, info-xref-xfile-alist)
(info-xref-filename-heading): Move to output managing section.
(info-xref-docstrings): New command checking "Info node `(foo)Bar'"
(info-xref-docstrings): New command checking "Info node `(foo)Bar'"
(info-xref-lock-file-p, info-xref-with-file): New helpers for it.
(info-xref-subfile-p): Move to generic section with those two.
(info-xref-check-node): New function split from
@ -1066,7 +1179,7 @@
(info-xref-check-node): Use it.
(info-xref-with-output): Show count of unavailables at end of output.
(info-xref-all-info-files): Exclude ".*" dotfiles. Ignore broken
symlinks. Exclude .texi files. Exclude Emacs backup files.
symlinks. Exclude .texi files. Exclude Emacs backup files.
(info-xref-check-all-custom): Fix quietening viper-mode and
gnus-registry-install -- use setq not let so as not to unbind
after load.
@ -1646,7 +1759,7 @@
(rmail-mime-insert-text): Call rmail-mime-insert-decoded-text.
(rmail-mime-insert-image): Argument changed. Caller changed.
(rmail-mime-image): Call rmail-mime-toggle-hidden.
(rmail-mime-set-bulk-data): New funciton.
(rmail-mime-set-bulk-data): New function.
(rmail-mime-insert-bulk): Argument changed.
(rmail-mime-multipart-handler): Return t.
(rmail-mime-process-multipart): Argument changed.
@ -1911,7 +2024,7 @@
(allout-toggle-subtree-encryption): Adjust docstrings to reflect
defaulting policy and other changes. Change fetch-pass to keymode-cue,
for simpler universal argument interpretation.
(allout-toggle-subtree-encryption): Adjust docstring to describe
(allout-toggle-subtree-encryption): Adjust docstring to describe
changed encryption provisions. Change fetch-pass to keymode-cue, for
simpler universal argument interpretation. Remove provisions for
handling key type and identity - they'll all be within
@ -2527,8 +2640,8 @@
and "psftp". Exchange "%k" marker with options.
(tramp-do-copy-or-rename-file, tramp-sh-handle-file-local-copy):
Compute size of link target.
(tramp-do-copy-or-rename-file-out-of-band). Move setting of
`tramp-current-*' up due to gateway methods. Optimze computing of
(tramp-do-copy-or-rename-file-out-of-band): Move setting of
`tramp-current-*' up due to gateway methods. Optimize computing of
copy arguments. Use `tramp-get-connection-name' and
`tramp-get-connection-buffer'. Improve debug messages.
(tramp-compute-multi-hops): Remove port determination.
@ -3780,7 +3893,7 @@
* international/characters.el (char-acronym-table): New variable.
(glyphless-char-control): New variable.
(update-glyphless-char-display): New funciton.
(update-glyphless-char-display): New function.
* faces.el (glyphless-char): New face.
@ -3851,7 +3964,7 @@
2010-10-31 Jan Djärv <jan.h.d@swipnet.se>
* term/x-win.el (x-get-selection-value): New function that gets
PRIMARY with type as specified in x-select-request-type. (Bug#6802).
PRIMARY with type as specified in x-select-request-type. (Bug#6802)
2010-10-31 Michael Albinus <michael.albinus@gmx.de>
@ -4140,7 +4253,7 @@
is indented differently if it is after a begin..end clock.
(verilog-in-attribute-p, verilog-skip-backward-comments)
(verilog-skip-forward-comment-p): Support proper treatment of
attributes by indent code. Reported by Jeff Steele.
attributes by indent code. Reported by Jeff Steele.
(verilog-in-directive-p): Fix comment to correctly describe function.
(verilog-backward-up-list, verilog-in-struct-region-p)
(verilog-backward-token, verilog-in-struct-p)
@ -4151,9 +4264,9 @@
(verilog-property-re, verilog-endcomment-reason-re)
(verilog-beg-of-statement, verilog-set-auto-endcomments)
(verilog-calc-1 ): Fix for assert a; else b; indentation (new form
of if). Reported by Max Bjurling and
of if). Reported by Max Bjurling and
(verilog-calc-1): Fix for clocking block in modport
declaration. Reported by Brian Hunter.
declaration. Reported by Brian Hunter.
2010-10-24 Wilson Snyder <wsnyder@wsnyder.org>
@ -4169,7 +4282,7 @@
(verilog-read-always-signals-recurse, verilog-read-decls): Fix not
treating `elsif similar to `endif inside AUTOSENSE.
(verilog-do-indent): Implement correct automatic or static task or
function end comment highlight. Reported by Steve Pearlmutter.
function end comment highlight. Reported by Steve Pearlmutter.
(verilog-font-lock-keywords-2): Fix highlighting of single
character pins, bug264. Reported by Michael Laajanen.
(verilog-auto-inst, verilog-read-decls, verilog-read-sub-decls)
@ -4180,7 +4293,7 @@
Reported by Mark Johnson.
(verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp):
Add 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF,
bug269. Suggested by Gary Delp.
bug269. Suggested by Gary Delp.
(verilog-mode-map, verilog-preprocess, verilog-preprocess-history)
(verilog-preprocessor, verilog-set-compile-command):
Create verilog-preprocess and verilog-preprocessor to show
@ -4188,7 +4301,7 @@
(verilog-get-beg-of-line, verilog-get-end-of-line)
(verilog-modi-file-or-buffer, verilog-modi-name)
(verilog-modi-point, verilog-within-string): Move defmacro's
before first use to avoid warning. Reported by Steve Pearlmutter.
before first use to avoid warning. Reported by Steve Pearlmutter.
(verilog-colorize-buffer, verilog-colorize-include-files-buffer)
(verilog-colorize-region, verilog-highlight-buffer)
(verilog-highlight-includes, verilog-highlight-modules)
@ -4220,7 +4333,7 @@
(verilog-alw-get-temps, verilog-auto-reset)
(verilog-auto-sense-sigs, verilog-read-always-signals)
(verilog-read-always-signals-recurse): Fix loop indexes being
AUTORESET. AUTORESET now assumes any variables in the
AUTORESET. AUTORESET now assumes any variables in the
initialization section of a for() should be ignored.
Reported by Dan Dever.
(verilog-error-font-lock-keywords)
@ -5633,7 +5746,7 @@
(sql-postgres-login-params): Add user and database defaults.
(sql-buffer-live-p): Bug fix.
(sql-product-history): New variable.
(sql-read-product): New function. Use it.
(sql-read-product): New function. Use it.
(sql-set-product, sql-product-interactive): Use it.
(sql-connection-history): New variable.
(sql-read-connection): New function. Use it.

8
lisp/Makefile.in
View file

@ -329,16 +329,16 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(MH_E_DIR)
# Update TRAMP internal autoloads. Maybe we could move trmp*.el into
# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
# an own subdirectory. OTOH, it does not hurt to keep them in
# lisp/net.
TRAMP_DIR = $(lisp)/net
TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \
$(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \
$(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \
$(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \
$(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \
$(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
$(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-sh.el \
$(TRAMP_DIR)/tramp-smb.el $(TRAMP_DIR)/tramp-uu.el \
$(TRAMP_DIR)/trampver.el
$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
$(emacs) -l autoload \

4
lisp/dired-aux.el
View file

@ -1383,6 +1383,10 @@ ESC or `q' to not overwrite any of the remaining files,
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
(when (and (file-directory-p from)
(file-directory-p to)
(eq file-creator 'dired-copy-file))
(setq to (file-name-directory to)))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)

168
lisp/dired-x.el
View file

@ -25,91 +25,47 @@
;;; Commentary:
;; This is Sebastian Kremer's excellent dired-x.el (Dired Extra), version
;; 1.191, hacked up for GNU Emacs. Redundant or conflicting material has
;; been removed or renamed in order to work properly with dired of GNU
;; Emacs. All suggestions or comments are most welcomed.
;; This is based on Sebastian Kremer's excellent dired-x.el (Dired Extra),
;; version 1.191, adapted for GNU Emacs. See the `dired-x' info pages.
;;
;; Please, PLEASE, *PLEASE* see the info pages.
;;
;; BUGS: Type M-x dired-x-submit-report and a report will be generated.
;; INSTALLATION: In your ~/.emacs,
;; USAGE: In your ~/.emacs,
;;
;; (add-hook 'dired-load-hook
;; (function (lambda ()
;; (load "dired-x")
;; (lambda ()
;; (require 'dired-x)
;; ;; Set global variables here. For example:
;; ;; (setq dired-guess-shell-gnutar "gtar")
;; )))
;; ))
;; (add-hook 'dired-mode-hook
;; (function (lambda ()
;; (lambda ()
;; ;; Set buffer-local variables here. For example:
;; ;; (dired-omit-mode 1)
;; )))
;; ))
;;
;; At load time dired-x.el will install itself, redefine some functions, and
;; bind some dired keys. *Please* see the info pages for more details.
;; bind some dired keys.
;; *Please* see the info pages for more details.
;; User customization: M-x customize-group RET dired-x RET.
;; User defined variables:
;;
;; dired-bind-vm
;; dired-vm-read-only-folders
;; dired-bind-jump
;; dired-bind-info
;; dired-bind-man
;; dired-x-hands-off-my-keys
;; dired-find-subdir
;; dired-enable-local-variables
;; dired-local-variables-file
;; dired-guess-shell-gnutar
;; dired-guess-shell-gzip-quiet
;; dired-guess-shell-znew-switches
;; dired-guess-shell-alist-user
;; dired-clean-up-buffers-too
;; dired-omit-mode
;; dired-omit-files
;; dired-omit-extensions
;; dired-omit-size-limit
;;
;; To find out more about these variables, load this file, put your cursor at
;; the end of any of the variable names, and hit C-h v [RET]. *Please* see
;; the info pages for more details.
;; When loaded this code redefines the following functions of GNU Emacs:
;; From dired.el: dired-clean-up-after-deletion, dired-find-buffer-nocreate,
;; and dired-initial-position.
;; From dired-aux.el: dired-add-entry and dired-read-shell-command.
;; When loaded this code redefines the following functions of GNU Emacs
;;
;; Function Found in this file of GNU Emacs
;; -------- -------------------------------
;; dired-clean-up-after-deletion ../lisp/dired.el
;; dired-find-buffer-nocreate ../lisp/dired.el
;; dired-initial-position ../lisp/dired.el
;;
;; dired-add-entry ../lisp/dired-aux.el
;; dired-read-shell-command ../lisp/dired-aux.el
;; *Please* see the `dired-x' info pages for more details.
;;; Code:
;; LOAD.
;; This is a no-op if dired-x is being loaded via `dired-load-hook'. It is
;; here in case the user has autoloaded dired-x via the dired-jump key binding
;; (instead of autoloading to dired as is suggested in the info-pages).
;; This is a no-op if dired-x is being loaded via `dired-load-hook',
;; but maybe not if a dired-x function is being autoloaded.
(require 'dired)
;; We will redefine some functions and also need some macros so we need to
;; load dired stuff of GNU Emacs.
;; We will redefine some functions and also need some macros.
(require 'dired-aux)
(defvar vm-folder-directory)
(eval-when-compile (require 'man))
;;; User-defined variables.
(defgroup dired-x nil
@ -340,10 +296,9 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
'dashes)))
;;; GLOBAL BINDING.
(if dired-bind-jump
(progn
(define-key global-map "\C-x\C-j" 'dired-jump)
(define-key global-map "\C-x4\C-j" 'dired-jump-other-window)))
(when dired-bind-jump
(define-key global-map "\C-x\C-j" 'dired-jump)
(define-key global-map "\C-x4\C-j" 'dired-jump-other-window))
;; Install into appropriate hooks.
@ -589,7 +544,7 @@ Should never be used as marker by the user or other packages.")
(let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files
(dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp))
(defvar dired-omit-extensions
(defcustom dired-omit-extensions
(append completion-ignored-extensions
dired-latex-unclean-extensions
dired-bibtex-unclean-extensions
@ -600,7 +555,9 @@ Defaults to elements of `completion-ignored-extensions',
`dired-texinfo-unclean-extensions'.
See interactive function `dired-omit-mode' \(\\[dired-omit-mode]\) and
variables `dired-omit-mode' and `dired-omit-files'.")
variables `dired-omit-mode' and `dired-omit-files'."
:type '(repeat string)
:group 'dired-x)
(defun dired-omit-expunge (&optional regexp)
"Erases all unmarked files matching REGEXP.
@ -896,12 +853,15 @@ Knows about the special cases in variable `default-directory-alist'."
;;; `dired-enable-local-variables' and run `hack-local-variables' on the
;;; Dired Buffer.
(defvar dired-local-variables-file (convert-standard-filename ".dired")
;; FIXME do standard dir-locals obsolete this?
(defcustom dired-local-variables-file (convert-standard-filename ".dired")
"Filename, as string, containing local dired buffer variables to be hacked.
If this file found in current directory, then it will be inserted into dired
buffer and `hack-local-variables' will be run. See Info node
`(emacs)File Variables' for more information on local variables.
See also `dired-enable-local-variables'.")
See also `dired-enable-local-variables'."
:type 'file
:group 'dired)
(defun dired-hack-local-variables ()
"Evaluate local variables in `dired-local-variables-file' for dired buffer."
@ -980,6 +940,8 @@ dired."
;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not
;; install GNU zip's version of zcat.
(declare-function Man-support-local-filenames "man" ())
(defvar dired-guess-shell-alist-default
(list
(list "\\.tar$"
@ -1429,6 +1391,8 @@ NOSELECT the files are merely found but not selected."
;; Run man on files.
(declare-function Man-getpage-in-background "man" (topic))
(defun dired-man ()
"Run man on this file. Display old buffer if buffer name matches filename.
Uses `man.el' of \\[manual-entry] fame."
@ -1449,11 +1413,8 @@ Uses `man.el' of \\[manual-entry] fame."
;; Run mail on mail folders.
;; Avoid compiler warning.
(eval-when-compile
(when (not (fboundp 'vm-visit-folder))
(defun vm-visit-folder (file &optional arg)
nil)))
(declare-function vm-visit-folder "ext:vm" (folder &optional read-only))
(defvar vm-folder-directory)
(defun dired-vm (&optional read-only)
"Run VM on this file.
@ -1659,11 +1620,17 @@ to mark all zero length files."
;;; FIND FILE AT POINT.
(defvar dired-x-hands-off-my-keys t
"*Non-nil means don't bind `dired-x-find-file' over `find-file' on keyboard.
(defcustom dired-x-hands-off-my-keys t
"Non-nil means don't bind `dired-x-find-file' over `find-file' on keyboard.
Similarly for `dired-x-find-file-other-window' over `find-file-other-window'.
If you change this variable after `dired-x.el' is loaded then do
\\[dired-x-bind-find-file].")
If you change this variable without using \\[customize] after `dired-x.el'
is loaded then call \\[dired-x-bind-find-file]."
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set sym val)
(dired-x-bind-find-file))
:group 'dired-x)
;; Bind `dired-x-find-file{-other-window}' over wherever
;; `find-file{-other-window}' is bound?
@ -1777,48 +1744,7 @@ If `current-prefix-arg' is non-nil, uses name at point as guess."
;;; BUG REPORTS
;; Fixme: get rid of this later.
;; This section is provided for reports. It uses Barry A. Warsaw's
;; reporter.el which is bundled with GNU Emacs v19.
(defconst dired-x-help-address "bug-gnu-emacs@gnu.org"
"Address(es) accepting submission of reports on dired-x.el.")
(defconst dired-x-variable-list
(list
'dired-bind-vm
'dired-vm-read-only-folders
'dired-bind-jump
'dired-bind-info
'dired-bind-man
'dired-find-subdir
'dired-enable-local-variables
'dired-local-variables-file
'dired-guess-shell-gnutar
'dired-guess-shell-gzip-quiet
'dired-guess-shell-znew-switches
'dired-guess-shell-alist-user
'dired-clean-up-buffers-too
'dired-omit-mode
'dired-omit-files
'dired-omit-extensions
)
"List of variables to be appended to reports sent by `dired-x-submit-report'.")
(defun dired-x-submit-report ()
"Submit via `reporter.el' a bug report on program.
Send report on `dired-x-file' version `dired-x-version', to
`dired-x-maintainer' at address `dired-x-help-address' listing
variables `dired-x-variable-list' in the message."
(interactive)
(reporter-submit-bug-report
dired-x-help-address ; address
"dired-x" ; pkgname
dired-x-variable-list ; varlist
nil nil ; pre-/post-hooks
""))
(define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1")
;; As Barry Warsaw would say: "This might be useful..."

4
lisp/dired.el
View file

@ -3570,7 +3570,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9f5fc434fa6c2607b6e66060862c9caf")
;;;;;; dired-diff) "dired-aux" "dired-aux.el" "e66465bcd1687d66cfb1202c9963d567")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
@ -4029,7 +4029,7 @@ true then the type of the file linked to by FILE is printed instead.
;;;***
;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el"
;;;;;; "fbac6ae123aaa2b2e9df8bb2cde61ceb")
;;;;;; "d35468f85920d324895b0c04bb703328")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\

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

@ -1797,7 +1797,7 @@ Replace with \"%s\"? " original replace)
(let ((found nil) (start (point)) (msg nil) (ms nil))
(while (and (not msg)
(re-search-forward
;; Ignore manual page refereces like
;; Ignore manual page references like
;; git-config(1).
"[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^](']"
e t))

18
lisp/emacs-lisp/cl-loaddefs.el
View file

@ -754,7 +754,7 @@ surrounded by (block NAME ...).
;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
;;;;;; substitute-if substitute delete-duplicates remove-duplicates
;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "43e0c1183e738e1e1038cdd84fde8366")
;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "df375ddc313f0c1c262cacab5cffd3e4")
;;; Generated autoloads from cl-seq.el
(autoload 'reduce "cl-seq" "\
@ -1080,7 +1080,7 @@ Keywords supported: :key
(autoload 'union "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or LIST2.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
@ -1090,7 +1090,7 @@ Keywords supported: :test :test-not :key
(autoload 'nunion "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or LIST2.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
@ -1100,7 +1100,7 @@ Keywords supported: :test :test-not :key
(autoload 'intersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The result list contains all items that appear in both LIST1 and LIST2.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
@ -1110,7 +1110,7 @@ Keywords supported: :test :test-not :key
(autoload 'nintersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The result list contains all items that appear in both LIST1 and LIST2.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
@ -1120,7 +1120,7 @@ Keywords supported: :test :test-not :key
(autoload 'set-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The result list contains all items that appear in LIST1 but not LIST2.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
@ -1130,7 +1130,7 @@ Keywords supported: :test :test-not :key
(autoload 'nset-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The result list contains all items that appear in LIST1 but not LIST2.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
@ -1140,7 +1140,7 @@ Keywords supported: :test :test-not :key
(autoload 'set-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The result list contains all items that appear in exactly one of LIST1, LIST2.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
@ -1150,7 +1150,7 @@ Keywords supported: :test :test-not :key
(autoload 'nset-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The result list contains all items that appear in exactly one of LIST1, LIST2.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.

16
lisp/emacs-lisp/cl-seq.el
View file

@ -770,7 +770,7 @@ Return the sublist of LIST whose car matches.
;;;###autoload
(defun union (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or LIST2.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
\nKeywords supported: :test :test-not :key
@ -791,7 +791,7 @@ to avoid corrupting the original LIST1 and LIST2.
;;;###autoload
(defun nunion (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or LIST2.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
\nKeywords supported: :test :test-not :key
@ -802,7 +802,7 @@ whenever possible.
;;;###autoload
(defun intersection (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The result list contains all items that appear in both LIST1 and LIST2.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
\nKeywords supported: :test :test-not :key
@ -825,7 +825,7 @@ to avoid corrupting the original LIST1 and LIST2.
;;;###autoload
(defun nintersection (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The result list contains all items that appear in both LIST1 and LIST2.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
\nKeywords supported: :test :test-not :key
@ -835,7 +835,7 @@ whenever possible.
;;;###autoload
(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The result list contains all items that appear in LIST1 but not LIST2.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
\nKeywords supported: :test :test-not :key
@ -855,7 +855,7 @@ to avoid corrupting the original LIST1 and LIST2.
;;;###autoload
(defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The result list contains all items that appear in LIST1 but not LIST2.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
\nKeywords supported: :test :test-not :key
@ -866,7 +866,7 @@ whenever possible.
;;;###autoload
(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The result list contains all items that appear in exactly one of LIST1, LIST2.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2.
\nKeywords supported: :test :test-not :key
@ -879,7 +879,7 @@ to avoid corrupting the original LIST1 and LIST2.
;;;###autoload
(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The result list contains all items that appear in exactly one of LIST1, LIST2.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
\nKeywords supported: :test :test-not :key

2
lisp/emulation/cua-base.el
View file

@ -246,7 +246,7 @@
;; [C-d] Moves (i.e. deletes and inserts) a single character to the
;; global mark.
;; [backspace] deletes the character before the global mark, while
;; [delete] deltes the character after the global mark.
;; [delete] deletes the character after the global mark.
;; [S-C-space] Jumps to and cancels the global mark.
;; [C-u S-C-space] Cancels the global mark (stays in current buffer).

20
lisp/faces.el
View file

@ -1577,13 +1577,25 @@ Optional parameter FRAME is the frame whose definition of FACE
is used. If nil or omitted, use the selected frame."
(unless frame
(setq frame (selected-frame)))
(let ((list face-attribute-name-alist)
(match t))
(let* ((list face-attribute-name-alist)
(match t)
(bold (and (plist-member attrs :bold)
(not (plist-member attrs :weight))))
(italic (and (plist-member attrs :italic)
(not (plist-member attrs :slant))))
(plist (if (or bold italic)
(copy-sequence attrs)
attrs)))
;; Handle the Emacs 20 :bold and :italic properties.
(if bold
(plist-put plist :weight (if bold 'bold 'normal)))
(if italic
(plist-put plist :slant (if italic 'italic 'normal)))
(while (and match list)
(let* ((attr (caar list))
(specified-value
(if (plist-member attrs attr)
(plist-get attrs attr)
(if (plist-member plist attr)
(plist-get plist attr)
'unspecified))
(value-now (face-attribute face attr frame)))
(setq match (equal specified-value value-now))

141
lisp/gnus/ChangeLog
View file

@ -1,3 +1,43 @@
2011-02-14 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-source-backend-parse-parameters): Don't rely on
`plist-get' to accept non-list parameters (XEmacs issue). Fix
docstring.
2011-02-14 Lars Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-inhibit-logging): New variable.
(nnimap-log-command): Don't log login commands.
* auth-source.el (auth-source-netrc-search): The asserts seem to want
to have more parameters.
* nnimap.el (nnimap-send-command): Mark the command time for each
command, so that we don't get NOOPs stepping on our toes.
* gnus-art.el (article-date-ut): Get the date from the Date header on
`t'.
2011-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
* auth-source.el (auth-source-search): Use copy-sequence instead of
the cl.el copy-list.
2011-02-13 Adam Sjøgren <asjo@koldfront.dk>
* gnus-delay.el (gnus-delay-article) Fix number of seconds per day.
Improve prompt.
2011-02-13 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-article-mode-line-format): Remove the article
washing status from the default format. It isn't very informative.
2011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change)
* nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): Fix
Gcc processing on imap.
2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca>
* message.el (message-bury): Don't pop up a new window when selected
@ -7,6 +47,30 @@
* gnus-sum.el (gnus-summary-save-parts): Use read-directory-name.
2011-02-10 Teodor Zlatanov <tzz@lifelogs.com>
* sieve-manage.el: Autoload `auth-source-search'.
(sieve-sasl-auth): Use it.
2011-02-09 Teodor Zlatanov <tzz@lifelogs.com>
* nnimap.el: Autoload `auth-source-forget+'.
(nnimap-open-connection-1): Use it if the connection fails.
* auth-source.el: Require `password-cache'.
(auth-source-hide-passwords, auth-source-cache): Remove and mark
obsolete.
(auth-source-magic): Marker for `password-cache' keys.
(auth-source-do-cache): Update docstring.
(auth-source-search): Use and check cache.
(auth-source-forget-all-cached, auth-source-remember)
(auth-source-recall, auth-source-forget, auth-source-forget+)
(auth-source-specmatchp): Caching support functions.
(auth-source-forget-user-or-password, auth-source-forget-all-cached):
Remove and obsolete.
(auth-source-user-or-password): Remove caching to further discourage
using it. Always hide passwords.
2011-02-09 Lars Ingebrigtsen <larsi@gnus.org>
* nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async
@ -17,6 +81,22 @@
* message.el (message-options): Make message-options really buffer
local.
2011-02-08 Teodor Zlatanov <tzz@lifelogs.com>
* mail-source.el: Autoload `auth-source-search'.
(mail-source-keyword-map): Note order matters.
(mail-source-set-1): Get all the mail-source source values and
defaults and search auth-source on those if needed. This can all
probably be simplified.
* nnimap.el: Autoload `auth-source-search'.
(nnimap-credentials): Use it.
(nnimap-open-connection-1): Ask for the virtual server and physical
address in one shot.
* nntp.el: Autoload `auth-source-search'.
(nntp-send-authinfo): Use it. Note TODO.
2011-02-08 Julien Danjou <julien@danjou.info>
* shr.el (shr-tag-body): Add support for text attribute in body
@ -24,6 +104,13 @@
* message.el (message-options): Make message-options a local variable.
2011-02-07 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-source-secrets-search)
(auth-source-user-or-password): Use `append' instead of `nconc'.
(auth-source-user-or-password): Build return list better and protect
against nil :secret.
2011-02-07 Lars Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-update-info): Refactor slightly.
@ -35,6 +122,13 @@
(nnimap-update-info): Fix macrology bug-out.
(nnimap-update-info): Simplify split history test.
2011-02-06 Michael Albinus <michael.albinus@gmx.de>
* auth-source.el (top): Require 'eieio unconditionally. Autoload
`secrets-get-attributes' instead of `secrets-get-attribute'.
(auth-source-secrets-search): Limit search when `max' is greater than
number of results.
2011-02-06 Lars Ingebrigtsen <larsi@gnus.org>
* nntp.el (nntp-finish-retrieve-group-infos): Protect against the first
@ -42,11 +136,58 @@
* proto-stream.el (open-protocol-stream): Document the return value.
2011-02-06 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-source-secrets-search): Add examples.
2011-02-06 Julien Danjou <julien@danjou.info>
* message.el (message-setup-1): Handle message-generate-headers-first
set to t.
2011-02-06 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-sources): Allow for simpler defaults for Secrets
API with a string "secrets:collection-name" and with 'default.
(auth-source-backend-parse): Parse "secrets:collection-name" and
'default. Recurse on parses instead of repeating code. Use the
Secrets API is the source is not nil and 'ignore otherwise. Emit a
message when ignoring a source.
(auth-source-search): List ignored search keys at the top level.
(auth-source-netrc-create): Use `case' instead of `cond'.
(auth-source-secrets-search): Created with TODOs.
(auth-source-secrets-create): Created with TODOs.
(auth-source-retrieve, auth-source-create, auth-source-delete)
(auth-source-protocol-defaults, auth-source-user-or-password-imap)
(auth-source-user-or-password-pop3, auth-source-user-or-password-ssh)
(auth-source-user-or-password-sftp)
(auth-source-user-or-password-smtp): Removed.
(auth-source-user-or-password): Deprecated and modified to be a wrapper
around `auth-source-search'. Not tested thoroughly.
2011-02-04 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el: Bring in assoc and eioeio libraries.
(secrets-enabled): New variable to track the status of the Secrets API.
(auth-source-backend): New EIOEIO class to represent a backend.
(auth-source-creation-defaults): New variable to set prompt defaults
during token creation (see the `auth-source-search' docstring for
details).
(auth-sources): Simplify to allow a simple string as a netrc backend
spec.
(auth-source-backend-parse): Parse a backend from an `auth-sources' spec.
(auth-source-backend-parse-parameters): Fill in the backend parameters.
(auth-source-search): Main auth-source API entry point.
(auth-source-delete): Wrapper around `auth-source-search' for deletion.
(auth-source-search-collection): Helper function for searching.
(auth-source-netrc-parse, auth-source-netrc-normalize)
(auth-source-netrc-search, auth-source-netrc-create): Netrc backend.
Supports search, create, and delete.
(auth-source-secrets-search, auth-source-secrets-create): Secrets API
backend stubs.
(auth-source-user-or-password): Call `auth-source-search' but it's not
ready yet.
2011-02-04 Lars Ingebrigtsen <larsi@gnus.org>
* message.el (message-setup-1): Remove the read-only stuff, since it

2
lisp/gnus/ChangeLog.2
View file

@ -6088,7 +6088,7 @@
(nntp-retrieve-groups): Ditto for groups.
(nntp-retrieve-articles): Ditto for articles.
(*): Replaced nntp-possibly-change-group calls to
nntp-with-open-group forms in all, but one, occurrance.
nntp-with-open-group forms in all, but one, occurrence.
(nntp-accept-process-output): Bug fix. Detect when called with
null process.

1218
lisp/gnus/auth-source.el
View file

File diff suppressed because it is too large Load diff

7
lisp/gnus/gnus-art.el
View file

@ -683,7 +683,7 @@ beginning of a line."
:type 'regexp
:group 'gnus-article-various)
(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
(defcustom gnus-article-mode-line-format "Gnus: %g %S%m"
"*The format specification for the article mode line.
See `gnus-summary-mode-line-format' for a closer description.
@ -691,6 +691,7 @@ The following additional specs are available:
%w The article washing status.
%m The number of MIME parts in the article."
:version "24.1"
:type 'string
:group 'gnus-article-various)
@ -3403,6 +3404,7 @@ possible values."
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
(first t)
(visible-date (mail-fetch-field "Date"))
pos date bface eface)
(save-excursion
(save-restriction
@ -3426,6 +3428,9 @@ possible values."
(delete-region (point-at-bol) (progn
(gnus-article-forward-header)
(point))))
(when (and (not date)
visible-date)
(setq date visible-date))
(when date
(article-transform-date date type bface eface)))))))

4
lisp/gnus/gnus-delay.el
View file

@ -78,7 +78,7 @@ DELAY is a string, giving the length of the time. Possible values are:
time, then the deadline is tomorrow, else today."
(interactive
(list (read-string
"Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
"Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): "
gnus-delay-default-delay)))
(let (num unit days year month day hour minute deadline)
(cond ((string-match
@ -105,7 +105,7 @@ DELAY is a string, giving the length of the time. Possible values are:
(append deadline nil))))
;; If this time has passed already, add a day.
(when (< deadline (gnus-float-time))
(setq deadline (+ 3600 deadline))) ;3600 secs/day
(setq deadline (+ 86400 deadline))) ; 86400 secs/day
;; Convert seconds to date header.
(setq deadline (message-make-date
(seconds-to-time deadline))))

88
lisp/gnus/mail-source.el
View file

@ -32,7 +32,7 @@
(eval-when-compile
(require 'cl)
(require 'imap))
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'auth-source-search "auth-source")
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(autoload 'nnheader-cancel-timer "nnheader")
@ -332,6 +332,7 @@ Common keywords should be listed here.")
(:prescript)
(:prescript-delay)
(:postscript)
;; note server and port need to come before user and password
(:server (getenv "MAILHOST"))
(:port 110)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
@ -345,6 +346,7 @@ Common keywords should be listed here.")
(:subdirs ("cur" "new"))
(:function))
(imap
;; note server and port need to come before user and password
(:server (getenv "MAILHOST"))
(:port)
(:stream)
@ -417,42 +419,66 @@ the `mail-source-keyword-map' variable."
(put 'mail-source-bind 'lisp-indent-function 1)
(put 'mail-source-bind 'edebug-form-spec '(sexp body))
;; TODO: use the list format for auth-source-user-or-password modes
(defun mail-source-set-1 (source)
(let* ((type (pop source))
(defaults (cdr (assq type mail-source-keyword-map)))
default value keyword auth-info user-auth pass-auth)
(defaults (cdr (assq type mail-source-keyword-map)))
(search '(:max 1))
found default value keyword auth-info user-auth pass-auth)
;; append to the search the useful info from the source and the defaults:
;; user, host, and port
;; the msname is the mail-source parameter
(dolist (msname '(:server :user :port))
;; the asname is the auth-source parameter
(let* ((asname (case msname
(:server :host) ; auth-source uses :host
(t msname)))
;; this is the mail-source default
(msdef1 (or (plist-get source msname)
(nth 1 (assoc msname defaults))))
;; ...evaluated
(msdef (mail-source-value msdef1)))
(setq search (append (list asname
(if msdef msdef t))
search))))
;; if the port is unknown yet, get it from the mail-source type
(unless (plist-get search :port)
(setq search (append (list :port (symbol-name type)))))
(while (setq default (pop defaults))
;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
;; using `mail-source-value' to evaluate the plist value
(set (mail-source-strip-keyword (setq keyword (car default)))
;; note the following reasons for this structure:
;; 1) the auth-sources user and password override everything
;; 2) it avoids macros, so it's cleaner
;; 3) it falls through to the mail-sources and then default values
(cond
((and
(eq keyword :user)
(setq user-auth
(nth 0 (auth-source-user-or-password
'("login" "password")
;; this is "host" in auth-sources
(if (boundp 'server) (symbol-value 'server) "")
type))))
user-auth)
((and
(eq keyword :password)
(setq pass-auth
(nth 1
(auth-source-user-or-password
'("login" "password")
;; this is "host" in auth-sources
(if (boundp 'server) (symbol-value 'server) "")
type))))
pass-auth)
(t (if (setq value (plist-get source keyword))
(mail-source-value value)
(mail-source-value (cadr default)))))))))
;; note the following reasons for this structure:
;; 1) the auth-sources user and password override everything
;; 2) it avoids macros, so it's cleaner
;; 3) it falls through to the mail-sources and then default values
(cond
((and
(eq keyword :user)
(setq user-auth (plist-get
;; cache the search result in `found'
(or found
(setq found (nth 0 (apply 'auth-source-search
search))))
:user)))
user-auth)
((and
(eq keyword :password)
(setq pass-auth (plist-get
;; cache the search result in `found'
(or found
(setq found (nth 0 (apply 'auth-source-search
search))))
:secret)))
;; maybe set the password to the return of the :secret function
(if (functionp pass-auth)
(setq pass-auth (funcall pass-auth))
pass-auth))
(t (if (setq value (plist-get source keyword))
(mail-source-value value)
(mail-source-value (cadr default)))))))))
(eval-and-compile
(defun mail-source-bind-common-1 ()

66
lisp/gnus/nnimap.el
View file

@ -47,8 +47,8 @@
(require 'nnmail)
(require 'proto-stream)
(autoload 'auth-source-forget-user-or-password "auth-source")
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'auth-source-forget+ "auth-source")
(autoload 'auth-source-search "auth-source")
(nnoo-declare nnimap)
@ -142,6 +142,8 @@ textual parts.")
(defvar nnimap-quirks
'(("QRESYNC" "Zimbra" "QRESYNC ")))
(defvar nnimap-inhibit-logging nil)
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
@ -275,18 +277,18 @@ textual parts.")
(current-buffer)))
(defun nnimap-credentials (address ports &optional inhibit-create)
(let (port credentials)
;; Request the credentials from all ports, but only query on the
;; last port if all the previous ones have failed.
(while (and (null credentials)
(setq port (pop ports)))
(setq credentials
(auth-source-user-or-password
'("login" "password") address port nil
(if inhibit-create
nil
(null ports)))))
credentials))
(let* ((found (nth 0 (auth-source-search :max 1
:host address
:port ports
:create (if inhibit-create
nil
(null ports)))))
(user (plist-get found :user))
(secret (plist-get found :secret))
(secret (if (functionp secret) (funcall secret) secret)))
(if found
(list user secret)
nil)))
(defun nnimap-keepalive ()
(let ((now (current-time)))
@ -381,26 +383,24 @@ textual parts.")
(if (eq nnimap-authenticator 'anonymous)
(list "anonymous"
(message-make-address))
(or
;; First look for the credentials based
;; on the virtual server name.
(nnimap-credentials
(nnoo-current-server 'nnimap) ports t)
;; Then look them up based on the
;; physical address.
(nnimap-credentials nnimap-address ports)))))
;; Look for the credentials based on
;; the virtual server name and the address
(nnimap-credentials
(list
(nnoo-current-server 'nnimap)
nnimap-address)
ports t))))
(setq nnimap-object nil)
(setq login-result
(nnimap-login (car credentials) (cadr credentials)))
(let ((nnimap-inhibit-logging t))
(setq login-result
(nnimap-login (car credentials) (cadr credentials))))
(unless (car login-result)
;; If the login failed, then forget the credentials
;; that are now possibly cached.
(dolist (host (list (nnoo-current-server 'nnimap)
nnimap-address))
(dolist (port ports)
(dolist (element '("login" "password"))
(auth-source-forget-user-or-password
element host port))))
(auth-source-forget+ :host host :protocol port)))
(delete-process (nnimap-process nnimap-object))
(setq nnimap-object nil))))
(when nnimap-object
@ -969,7 +969,8 @@ textual parts.")
(nnimap-add-cr)
(setq message (buffer-substring-no-properties (point-min) (point-max)))
(with-current-buffer (nnimap-buffer)
(when (setq message (nnimap-process-quirk "OK Gimap " 'append message))
(when (setq message (or (nnimap-process-quirk "OK Gimap " 'append message)
message))
;; If we have this group open read-only, then unselect it
;; before appending to it.
(when (equal (nnimap-examined nnimap-object) group)
@ -997,7 +998,7 @@ textual parts.")
(defun nnimap-process-quirk (greeting-match type data)
(when (and (nnimap-greeting nnimap-object)
(string-match "OK Gimap " (nnimap-greeting nnimap-object))
(string-match greeting-match (nnimap-greeting nnimap-object))
(eq type 'append)
(string-match "\000" data))
(let ((choice (gnus-multiple-choice
@ -1567,6 +1568,7 @@ textual parts.")
(defvar nnimap-sequence 0)
(defun nnimap-send-command (&rest args)
(setf (nnimap-last-command-time nnimap-object) (current-time))
(process-send-string
(get-buffer-process (current-buffer))
(nnimap-log-command
@ -1585,12 +1587,14 @@ textual parts.")
(defun nnimap-log-command (command)
(with-current-buffer (get-buffer-create "*imap log*")
(goto-char (point-max))
(insert (format-time-string "%H:%M:%S") " " command))
(insert (format-time-string "%H:%M:%S") " "
(if nnimap-inhibit-logging
"(inhibited)"
command)))
command)
(defun nnimap-command (&rest args)
(erase-buffer)
(setf (nnimap-last-command-time nnimap-object) (current-time))
(let* ((sequence (apply #'nnimap-send-command args))
(response (nnimap-get-response sequence)))
(if (equal (caar response) "OK")

16
lisp/gnus/nntp.el
View file

@ -40,7 +40,7 @@
(eval-when-compile (require 'cl))
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'auth-source-search "auth-source")
(defgroup nntp nil
"NNTP access for Gnus."
@ -1231,10 +1231,16 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(let* ((list (netrc-parse nntp-authinfo-file))
(alist (netrc-machine list nntp-address "nntp"))
(force (or (netrc-get alist "force") nntp-authinfo-force))
(auth-info
(auth-source-user-or-password '("login" "password") nntp-address "nntp"))
(auth-user (nth 0 auth-info))
(auth-passwd (nth 1 auth-info))
(auth-info
(nth 0 (auth-source-search :max 1
;; TODO: allow the virtual server name too
:host nntp-address
:port '("119" "nntp"))))
(auth-user (plist-get auth-info :user))
(auth-passwd (plist-get auth-info :secret))
(auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(user (or
;; this is preferred to netrc-*
auth-user

18
lisp/gnus/sieve-manage.el
View file

@ -83,7 +83,7 @@
(require 'starttls))
(autoload 'sasl-find-mechanism "sasl")
(autoload 'starttls-open-stream "starttls")
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'auth-source-search "auth-source")
;; User customizable variables:
@ -273,16 +273,20 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
"Login to server using the SASL MECH method."
(message "sieve: Authenticating using %s..." mech)
(with-current-buffer buffer
(let* ((user-password (auth-source-user-or-password
'("login" "password")
sieve-manage-server
"sieve" nil t))
(let* ((auth-info (auth-source-search :host sieve-manage-server
:port "sieve"
:max 1))
(user-name (plist-get (nth 0 auth-info) :user))
(user-password (plist-get (nth 0 auth-info) :secret))
(user-password (if (functionp user-password)
(funcall user-password)
user-password))
(client (sasl-make-client (sasl-find-mechanism (list mech))
(car user-password) "sieve" sieve-manage-server))
user-name "sieve" sieve-manage-server))
(sasl-read-passphrase
;; We *need* to copy the password, because sasl will modify it
;; somehow.
`(lambda (prompt) ,(copy-sequence (cadr user-password))))
`(lambda (prompt) ,(copy-sequence user-password)))
(step (sasl-next-step client nil))
(tag (sieve-manage-send
(concat

6
lisp/makefile.w32-in
View file

@ -443,9 +443,9 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \
$(lisp)/net/tramp-cmds.el $(lisp)/net/tramp-compat.el \
$(lisp)/net/tramp-ftp.el $(lisp)/net/tramp-gvfs.el \
$(lisp)/net/tramp-gw.el $(lisp)/net/tramp-imap.el \
$(lisp)/net/tramp-sh.el $(lisp)/net/tramp-smb.el \
$(lisp)/net/tramp-uu.el $(lisp)/net/trampver.el
$(lisp)/net/tramp-gw.el $(lisp)/net/tramp-sh.el \
$(lisp)/net/tramp-smb.el $(lisp)/net/tramp-uu.el \
$(lisp)/net/trampver.el
$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC)
"$(EMACS)" $(EMACSOPT) \

2
lisp/mh-e/ChangeLog.1
View file

@ -3499,7 +3499,7 @@
2003-05-08 Satyaki Das <satyakid@stanford.edu>
* mh-seq.el (mh-translate-range): Take into account differnt
* mh-seq.el (mh-translate-range): Take into account different
semantics of split-string in Emacs and XEmacs.
(mh-read-pick-regexp, mh-narrow-to-from, mh-narrow-to-cc)
(mh-narrow-to-to, mh-narrow-to-header-field)

374
lisp/net/imap-hash.el
View file

@ -1,374 +0,0 @@
;;; imap-hash.el --- Hashtable-like interface to an IMAP mailbox
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: mail
;; This program 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.
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module provides hashtable-like functions on top of imap.el
;; functionality. All the authentication is handled by auth-source so
;; there are no authentication options here, only the server and
;; mailbox names are needed.
;; Create a IHT (imap-hash table) object with `imap-hash-make'. Then
;; use it with `imap-hash-map' to map a function across all the
;; messages. Use `imap-hash-get' and `imap-hash-rem' to operate on
;; individual messages. See the tramp-imap.el library in Tramp if you
;; need to see practical examples.
;; This only works with IMAP4r1. Sorry to everyone without it, but
;; the compatibility code is too annoying and it's 2009.
;; TODO: Use SEARCH instead of FETCH when a test is specified. List
;; available mailboxes. Don't select an invalid mailbox.
;;; Code:
(require 'assoc)
(require 'imap)
(require 'sendmail) ; for mail-header-separator
(require 'message)
(autoload 'auth-source-search "auth-source")
;; retrieve these headers
(defvar imap-hash-headers
(append '(Subject From Date Message-Id References In-Reply-To Xref)))
;; from nnheader.el
(defsubst imap-hash-remove-cr-followed-by-lf ()
(goto-char (point-max))
(while (search-backward "\r\n" nil t)
(delete-char 1)))
;; from nnheader.el
(defun imap-hash-ms-strip-cr (&optional string)
"Strip ^M from the end of all lines in current buffer or STRING."
(if string
(with-temp-buffer
(insert string)
(imap-hash-remove-cr-followed-by-lf)
(buffer-string))
(save-excursion
(imap-hash-remove-cr-followed-by-lf))))
(defun imap-hash-make (server port mailbox &optional user password ssl)
"Make a new imap-hash object using SERVER, PORT, and MAILBOX.
USER, PASSWORD and SSL are optional.
The test is set to t, meaning all messages are considered."
(when (and server port mailbox)
(list :server server :port port :mailbox mailbox
:ssl ssl :user user :password password
:test t)))
(defun imap-hash-p (iht)
"Check whether IHT is a valid imap-hash."
(and
(imap-hash-server iht)
(imap-hash-port iht)
(imap-hash-mailbox iht)
(imap-hash-test iht)))
(defmacro imap-hash-gather (uid)
`(imap-message-get ,uid 'BODYDETAIL))
(defmacro imap-hash-data-body (details)
`(nth 2 (nth 1 ,details)))
(defmacro imap-hash-data-headers (details)
`(nth 2 (nth 0 ,details)))
(defun imap-hash-get (key iht &optional refetch)
"Get the value for KEY in the imap-hash IHT.
Requires either `imap-hash-fetch' to be called beforehand
\(e.g. by `imap-hash-map'), or REFETCH to be t.
Returns a list of the headers (an alist, see `imap-hash-map') and
the body of the message as a string.
Also see `imap-hash-test'."
(with-current-buffer (imap-hash-get-buffer iht)
(when refetch
(imap-hash-fetch iht nil key))
(let ((details (imap-hash-gather key)))
(list
(imap-hash-get-headers
(imap-hash-data-headers details))
(imap-hash-get-body
(imap-hash-data-body details))))))
(defun imap-hash-put (value iht &optional key)
"Put VALUE in the imap-hash IHT. Return the new key.
If KEY is given, removes it.
VALUE can be a list of the headers (an alist, see `imap-hash-map')
and the body of the message as a string. It can also be a uid,
in which case `imap-hash-get' will be called to get the value.
Also see `imap-hash-test'."
(let ((server-buffer (imap-hash-get-buffer iht))
(value (if (listp value) value (imap-hash-get value iht)))
newuid)
(when value
(with-temp-buffer
(funcall 'imap-hash-make-message
(nth 0 value)
(nth 1 value)
nil)
(setq newuid (nth 1 (imap-message-append
(imap-hash-mailbox iht)
(current-buffer) nil nil server-buffer)))
(when key (imap-hash-rem key iht))))
newuid))
(defun imap-hash-make-message (headers body &optional overrides)
"Make a message with HEADERS and BODY suitable for `imap-append',
using `message-setup'.
Look in the alist OVERRIDES for header overrides as per `imap-hash-headers'."
;; don't insert a signature no matter what
(let (message-signature)
(message-setup
(append overrides headers))
(message-generate-headers message-required-mail-headers)
(message-remove-header "X-Draft-From")
(message-goto-body)
(insert (or (aget overrides 'body)
body
""))
(goto-char (point-min))
;; TODO: make this search better
(if (search-forward mail-header-separator nil t)
(delete-region (line-beginning-position) (line-end-position))
(error "Could not find the body separator in the encoded message!"))))
(defun imap-hash-rem (key iht)
"Remove KEY in the imap-hash IHT.
Also see `imap-hash-test'. Requires `imap-hash-fetch' to have
been called and the imap-hash server buffer to be current,
so it's best to use it inside `imap-hash-map'.
The key will not be found on the next `imap-hash-map' call."
(with-current-buffer (imap-hash-get-buffer iht)
(imap-message-flags-add
(imap-range-to-message-set (list key))
"\\Deleted" 'silent)
(imap-mailbox-expunge t)))
(defun imap-hash-clear (iht)
"Remove all keys in the imap-hash IHT.
Also see `imap-hash-test'."
(imap-hash-map (lambda (uid b c) (imap-hash-rem uid iht)) iht))
(defun imap-hash-get-headers (text-headers)
(with-temp-buffer
(insert (or text-headers ""))
(imap-hash-remove-cr-followed-by-lf)
(mapcar (lambda (header)
(cons header
(message-fetch-field (format "%s" header))))
imap-hash-headers)))
(defun imap-hash-get-body (text)
(with-temp-buffer
(insert (or text ""))
(imap-hash-remove-cr-followed-by-lf)
(buffer-string)))
(defun imap-hash-map (function iht &optional headers-only &rest messages)
"Call FUNCTION for all entries in IHT and pass it the message uid,
the headers (an alist, see `imap-hash-headers'), and the body
contents as a string. If HEADERS-ONLY is not nil, the body will be nil.
Returns results of evaluating, as would `mapcar'.
If MESSAGES are given, iterate only over those UIDs.
Also see `imap-hash-test'."
(imap-hash-fetch iht headers-only)
(let ((test (imap-hash-test iht)))
(with-current-buffer (imap-hash-get-buffer iht)
(delq nil
(imap-message-map (lambda (message ignored-parameter)
(let* ((details (imap-hash-gather message))
(headers (imap-hash-data-headers details))
(hlist (imap-hash-get-headers headers))
(runit (cond
((stringp test)
(string-match
test
(format "%s" (aget hlist 'Subject))))
((functionp test)
(funcall test hlist))
;; otherwise, return test itself
(t test))))
;;(debug message headers)
(when runit
(funcall function
message
(imap-hash-get-headers
headers)
(imap-hash-get-body
(imap-hash-data-body details))))))
"UID")))))
(defun imap-hash-count (iht)
"Count the number of messages in the imap-hash IHT.
Also see `imap-hash-test'. It uses `imap-hash-map' so just use that
function if you want to do more than count the elements."
(length (imap-hash-map (lambda (a b c)) iht t)))
(defalias 'imap-hash-size 'imap-hash-count)
(defun imap-hash-test (iht)
"Return the test used by `imap-hash-map' for IHT.
When the test is t, any key will be a candidate.
When the test is a string, messages will be filtered on that string as a
regexp against the subject.
When the test is a function, messages will be filtered with it.
The function is passed the message headers (see `imap-hash-get-headers')."
(plist-get iht :test))
(defun imap-hash-server (iht)
"Return the server used by the imap-hash IHT."
(plist-get iht :server))
(defun imap-hash-port (iht)
"Return the port used by the imap-hash IHT."
(plist-get iht :port))
(defun imap-hash-ssl (iht)
"Return the SSL need for the imap-hash IHT."
(plist-get iht :ssl))
(defun imap-hash-mailbox (iht)
"Return the mailbox used by the imap-hash IHT."
(plist-get iht :mailbox))
(defun imap-hash-user (iht)
"Return the username used by the imap-hash IHT."
(plist-get iht :user))
(defun imap-hash-password (iht)
"Return the password used by the imap-hash IHT."
(plist-get iht :password))
(defun imap-hash-open-connection (iht)
"Open the connection used for IMAP interactions with the imap-hash IHT."
(let* ((server (imap-hash-server iht))
(port (imap-hash-port iht))
(ssl-need (imap-hash-ssl iht))
(auth-need (not (and (imap-hash-user iht)
(imap-hash-password iht))))
;; this will not be needed if auth-need is t
(auth-info (when auth-need
(nth 0 (auth-source-search :host server :port port))))
(auth-user (or (imap-hash-user iht)
(plist-get auth-info :user)))
(auth-passwd (or (imap-hash-password iht)
(plist-get auth-info :secret)))
(auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(imap-logout-timeout nil))
;; (debug "opening server: opened+state" (imap-opened) imap-state)
;; this is the only place where IMAP vs IMAPS matters
(if (imap-open server port (if ssl-need 'ssl nil) nil (current-buffer))
(progn
;; (debug "after opening server: opened+state" (imap-opened (current-buffer)) imap-state)
;; (debug "authenticating" auth-user auth-passwd)
(if (not (imap-capability 'IMAP4rev1))
(error "IMAP server does not support IMAP4r1, it won't work, sorry")
(imap-authenticate auth-user auth-passwd)
(imap-id)
;; (debug "after authenticating: opened+state" (imap-opened (current-buffer)) imap-state)
(imap-opened (current-buffer))))
(error "Could not open the IMAP buffer"))))
(defun imap-hash-get-buffer (iht)
"Get or create the connection buffer to be used for the imap-hash IHT."
(let* ((name (imap-hash-buffer-name iht))
(buffer (get-buffer name)))
(if (and buffer (imap-opened buffer))
buffer
(when buffer (kill-buffer buffer))
(with-current-buffer (get-buffer-create name)
(setq buffer-undo-list t)
(when (imap-hash-open-connection iht)
(current-buffer))))))
(defun imap-hash-buffer-name (iht)
"Get the connection buffer to be used for the imap-hash IHT."
(when (imap-hash-p iht)
(let ((server (imap-hash-server iht))
(port (imap-hash-port iht))
(ssl-text (if (imap-hash-ssl iht) "SSL" "NoSSL")))
(format "*imap-hash/%s:%s:%s*" server port ssl-text))))
(defun imap-hash-fetch (iht &optional headers-only &rest messages)
"Fetch all the messages for imap-hash IHT.
Get only the headers if HEADERS-ONLY is not nil."
(with-current-buffer (imap-hash-get-buffer iht)
(let ((range (if messages
(list
(imap-range-to-message-set messages)
(imap-range-to-message-set messages))
'("1:*" . "1,*:*"))))
;; (with-current-buffer "*imap-debug*"
;; (erase-buffer))
(imap-mailbox-unselect)
(imap-mailbox-select (imap-hash-mailbox iht))
;; (debug "after selecting mailbox: opened+state" (imap-opened) imap-state)
;; (setq imap-message-data (make-vector imap-message-prime 0)
(imap-fetch-safe range
(concat (format "(UID RFC822.SIZE BODY %s "
(if headers-only "" "BODY.PEEK[TEXT]"))
(format "BODY.PEEK[HEADER.FIELDS %s])"
imap-hash-headers))))))
(provide 'imap-hash)
;;; imap-hash.el ends here
;; ignore, for testing only
;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "INBOX.test"))
;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "test"))
;;; (imap-hash-make "server1" "INBOX.mailbox2")
;;; (imap-hash-p iht)
;;; (imap-hash-get 35 iht)
;;; (imap-hash-get 38 iht)
;;; (imap-hash-get 37 iht t)
;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("*imap-debug*" "*imap-log*"))
;;; (imap-hash-put (imap-hash-get 5 iht) iht)
;;; (with-current-buffer (imap-hash-get-buffer iht) (let ((uid (imap-hash-put (imap-hash-get 5 iht) iht))) (imap-hash-put uid iht uid)))
;;; (imap-hash-put (imap-hash-get 35 iht) iht)
;;; (imap-hash-make-message '((Subject . "normal")) "normal body")
;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "new")))
;;; (imap-hash-make-message '((Subject . "old")) "old body" '((body . "new body")) (lambda (subject) (concat "overwrite-" subject)))
;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "change this")) (lambda (subject) (concat "overwrite-" subject)))
;;; (imap-hash-make-message '((Subject . "Twelcome")) "body here" nil)
;; (with-current-buffer (imap-hash-get-buffer iht) (imap-hash-rem (imap-hash-put (imap-hash-get 5 iht) iht) iht))
;;; (kill-buffer (imap-hash-buffer-name iht))
;;; (imap-hash-map 'debug iht)
;;; (imap-hash-map 'debug iht t)
;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome")
;;;(imap-hash-count iht)
;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("*imap-debug*" "*imap-log*"))
;;; (kill-buffer (imap-hash-buffer-name iht))
;;; this should always return t if the server is up, automatically reopening if needed
;;; (imap-opened (imap-hash-get-buffer iht))
;;; (imap-hash-buffer-name iht)
;;; (with-current-buffer (imap-hash-get-buffer iht) (debug "mailbox data, auth and state" imap-mailbox-data imap-auth imap-state))
;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome")
;;; (imap-hash-fetch iht nil)
;;; (imap-hash-fetch iht t)
;;; (imap-hash-fetch iht nil 1 2 3)
;;; (imap-hash-fetch iht t 1 2 3)

850
lisp/net/tramp-imap.el
View file

@ -1,850 +0,0 @@
;;; tramp-imap.el --- Tramp interface to IMAP through imap.el
;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: mail, comm
;; Package: tramp
;; 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/>.
;;; Commentary:
;; Package to provide Tramp over IMAP
;;; Setup:
;; just load and open files, e.g.
;; /imaps:user@yourhosthere.com:/INBOX.test/1
;; or
;; /imap:user@yourhosthere.com:/INBOX.test/1
;; where `imap' goes over IMAP, while `imaps' goes over IMAP+SSL
;; This module will use imap-hash.el to access the IMAP mailbox.
;; This module will use auth-source.el to authenticate against the
;; IMAP server, PLUS it will use auth-source.el to get your passphrase
;; for the symmetrically encrypted messages. For the former, use the
;; usual IMAP ports. For the latter, use the port "tramp-imap".
;; example .authinfo / .netrc file:
;; machine yourhosthere.com port tramp-imap login USER password SYMMETRIC-PASSPHRASE
;; note above is the symmetric encryption passphrase for GPG
;; below is the regular password for IMAP itself and other things on that host
;; machine yourhosthere.com login USER password NORMAL-PASSWORD
;;; Code:
(require 'assoc)
(require 'tramp)
(autoload 'auth-source-search "auth-source")
(autoload 'epg-context-operation "epg")
(autoload 'epg-context-set-armor "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-context-set-progress-callback "epg")
(autoload 'epg-decrypt-string "epg")
(autoload 'epg-encrypt-string "epg")
(autoload 'epg-make-context "epg")
(autoload 'imap-hash-get "imap-hash")
(autoload 'imap-hash-make "imap-hash")
(autoload 'imap-hash-map "imap-hash")
(autoload 'imap-hash-put "imap-hash")
(autoload 'imap-hash-rem "imap-hash")
;; We use the additional header "X-Size" for encoding the size of a file.
(eval-after-load "imap-hash"
'(add-to-list 'imap-hash-headers 'X-Size 'append))
;; Define Tramp IMAP method ...
;;;###tramp-autoload
(defconst tramp-imap-method "imap"
"*Method to connect via IMAP protocol.")
;;;###tramp-autoload
(when (and (locate-library "epa") (locate-library "imap-hash"))
(add-to-list 'tramp-methods
(list tramp-imap-method '(tramp-default-port 143))))
;; Define Tramp IMAPS method ...
;;;###tramp-autoload
(defconst tramp-imaps-method "imaps"
"*Method to connect via secure IMAP protocol.")
;; ... and add it to the method list.
;;;###tramp-autoload
(when (and (locate-library "epa") (locate-library "imap-hash"))
(add-to-list 'tramp-methods
(list tramp-imaps-method '(tramp-default-port 993))))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
;;;###tramp-autoload
(add-to-list
'tramp-default-user-alist
(list (concat "\\`"
(regexp-opt (list tramp-imap-method tramp-imaps-method))
"\\'")
nil (user-login-name)))
;; Add completion function for IMAP method.
;; (tramp-set-completion-function
;; tramp-imap-method tramp-completion-function-alist-ssh) ; TODO: test this
;; tramp-imaps-method tramp-completion-function-alist-ssh) ; TODO: test this
;; New handlers should be added here.
(defconst tramp-imap-file-name-handler-alist
'(
;; `access-file' performed by default handler
(add-name-to-file . ignore)
;; `byte-compiler-base-file-name' performed by default handler
;; `copy-directory' performed by default handler
(copy-file . tramp-imap-handle-copy-file)
(delete-directory . ignore) ;; tramp-imap-handle-delete-directory)
(delete-file . tramp-imap-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler
(directory-file-name . tramp-handle-directory-file-name)
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-call-process . ignore)
;; `dired-compress-file' performed by default handler
;; `dired-uncache' performed by default handler
(expand-file-name . tramp-imap-handle-expand-file-name)
;; `file-accessible-directory-p' performed by default handler
(file-attributes . tramp-imap-handle-file-attributes)
(file-directory-p . tramp-imap-handle-file-directory-p)
(file-executable-p . ignore)
(file-exists-p . tramp-handle-file-exists-p)
(file-local-copy . tramp-imap-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-imap-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-completion . tramp-handle-file-name-completion)
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
;; `file-selinux-context' performed by default handler.
(file-symlink-p . tramp-handle-file-symlink-p)
;; `file-truename' performed by default handler
(file-writable-p . tramp-imap-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler
;; `get-file-buffer' performed by default handler
(insert-directory . tramp-imap-handle-insert-directory)
(insert-file-contents . tramp-imap-handle-insert-file-contents)
(load . tramp-handle-load)
(make-directory . ignore) ;; tramp-imap-handle-make-directory)
(make-directory-internal . ignore) ;; tramp-imap-handle-make-directory-internal)
(make-symbolic-link . ignore)
(rename-file . tramp-imap-handle-rename-file)
(set-file-modes . ignore)
;; `set-file-selinux-context' performed by default handler.
(set-file-times . ignore) ;; tramp-imap-handle-set-file-times)
(set-visited-file-modtime . ignore)
(shell-command . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
(verify-visited-file-modtime . ignore)
(write-region . tramp-imap-handle-write-region)
(executable-find . ignore)
(start-file-process . ignore)
(process-file . ignore)
)
"Alist of handler functions for Tramp IMAP method.
Operations not mentioned here will be handled by the default Emacs primitives.")
(defgroup tramp-imap nil
"Tramp over IMAP configuration."
:version "23.2"
:group 'tramp)
(defcustom tramp-imap-subject-marker "tramp-imap-subject-marker"
"The subject marker that Tramp-IMAP will use."
:type 'string
:version "23.2"
:group 'tramp-imap)
;; TODO: these will be defcustoms later.
(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never
(defvar tramp-imap-passphrase nil)
;;;###tramp-autoload
(defsubst tramp-imap-file-name-p (filename)
"Check if it's a filename for IMAP protocol."
(let ((v (tramp-dissect-file-name filename)))
(or
(string= (tramp-file-name-method v) tramp-imap-method)
(string= (tramp-file-name-method v) tramp-imaps-method))))
;;;###tramp-autoload
(defun tramp-imap-file-name-handler (operation &rest args)
"Invoke the IMAP related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(let ((fn (assoc operation tramp-imap-file-name-handler-alist)))
(if fn
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
;;;###tramp-autoload
(when (and (locate-library "epa") (locate-library "imap-hash"))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)))
(defun tramp-imap-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-selinux-context)
"Like `copy-file' for Tramp files."
(tramp-imap-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
(defun tramp-imap-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(tramp-imap-do-copy-or-rename-file
'rename filename newname ok-if-already-exists t t))
(defun tramp-imap-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Copy or rename a remote file.
OP must be `copy' or `rename' and indicates the operation to perform.
FILENAME specifies the file to copy or rename, NEWNAME is the name of
the new file (for copy) or the new name of the file (for rename).
OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
KEEP-DATE means to make sure that NEWNAME has the same timestamp
as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
the uid and gid if both files are on the same host.
This function is invoked by `tramp-imap-handle-copy-file' and
`tramp-imap-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
(when (file-directory-p newname)
(setq newname (expand-file-name (file-name-nondirectory filename) newname)))
(let ((t1 (and (tramp-tramp-file-p filename)
(tramp-imap-file-name-p filename)))
(t2 (and (tramp-tramp-file-p newname)
(tramp-imap-file-name-p newname))))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error
v 'file-already-exists "File %s already exists" newname))
(with-progress-reporter
v 0 (format "%s %s to %s"
(if (eq op 'copy) "Copying" "Renaming")
filename newname)
;; We just make a local copy of FILENAME, and write it then to
;; NEWNAME. This must be optimized when both files are
;; located on the same IMAP server.
(with-temp-buffer
(if (and t1 t2)
;; We don't encrypt.
(with-parsed-tramp-file-name newname v1
(insert (tramp-imap-get-file filename nil))
(tramp-imap-put-file
v1 (current-buffer)
(tramp-imap-file-name-name v1)
nil nil (nth 7 (file-attributes filename))))
;; One of them is not located on a IMAP mailbox.
(insert-file-contents filename)
(write-region (point-min) (point-max) newname)))))
(when (eq op 'rename) (delete-file filename))))
;; TODO: revise this much
(defun tramp-imap-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
;; If NAME is not a Tramp file, run the real handler.
(if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
(tramp-drop-volume-letter
(tramp-run-real-handler 'expand-file-name (list name nil)))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; We bind `directory-sep-char' here for XEmacs on Windows,
;; which would otherwise use backslash. `default-directory' is
;; bound, because on Windows there would be problems with UNC
;; shares or Cygwin mounts.
(let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
method user host
(tramp-drop-volume-letter
(tramp-run-real-handler
'expand-file-name (list localname))))))))
;; This function should return "foo/" for directories and "bar" for
;; files.
(defun tramp-imap-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(save-match-data
(let ((entries
(tramp-imap-get-file-entries v localname)))
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 9 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
entries))))))
(defun tramp-imap-get-file-entries (vec localname &optional exact)
"Read entries returned by IMAP server. EXACT limits to exact matches.
Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
SIZE MODE WEIRD INODE DEVICE)."
(tramp-message vec 5 "working on %s" localname)
(let* ((name (tramp-imap-file-name-name vec))
(search-name (or name ""))
(search-name (if exact (concat search-name "$") search-name))
(iht (tramp-imap-make-iht vec search-name)))
;; TODO: catch errors
;; (tramp-error vec 'none "bad name %s or mailbox %s" name mbox))
(imap-hash-map (lambda (uid headers body)
(let ((subject (substring
(aget headers 'Subject "")
(length tramp-imap-subject-marker)))
(from (aget headers 'From ""))
(date (date-to-time (aget headers 'Date "")))
(size (string-to-number
(or (aget headers 'X-Size "0") "0"))))
(setq from
(if (string-match "<\\([^@]+\\)@" from)
(match-string 1 from)
"nobody"))
(list
subject
nil
-1
from
"nogroup"
date
date
date
size
"-rw-rw-rw-"
nil
uid
(tramp-get-device vec))))
iht t)))
(defun tramp-imap-handle-write-region (start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs))
confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? "
filename))
(tramp-error v 'file-error "File not overwritten")))
(tramp-flush-file-property v localname)
(let* ((old-buffer (current-buffer))
(inode (tramp-imap-get-file-inode filename))
(min 1)
(max (point-max))
;; Make sure we have good start and end values.
(start (or start min))
(end (or end max))
temp-buffer)
(with-temp-buffer
(setq temp-buffer (if (and (eq start min) (eq end max))
old-buffer
;; If this is a region write, insert the substring.
(insert
(with-current-buffer old-buffer
(buffer-substring-no-properties start end)))
(current-buffer)))
(tramp-imap-put-file v
temp-buffer
(tramp-imap-file-name-name v)
inode
t)))
(when (eq visit t)
(set-visited-file-modtime))))
(defun tramp-imap-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(if full-directory-p
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
(with-parsed-tramp-file-name filename nil
(save-match-data
(let ((base (file-name-nondirectory localname))
(entries (copy-sequence
(tramp-imap-get-file-entries
v (file-name-directory localname)))))
(when wildcard
(when (string-match "\\." base)
(setq base (replace-match "\\\\." nil nil base)))
(when (string-match "\\*" base)
(setq base (replace-match ".*" nil nil base)))
(when (string-match "\\?" base)
(setq base (replace-match ".?" nil nil base))))
;; Filter entries.
(setq entries
(delq
nil
(if (or wildcard (zerop (length base)))
;; Check for matching entries.
(mapcar
(lambda (x)
(when (string-match
(format "^%s" base) (nth 0 x))
x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
;; Sort entries.
(setq entries
(sort
entries
(lambda (x y)
(if (string-match "t" switches)
;; Sort by date.
(tramp-time-less-p (nth 6 y) (nth 6 x))
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
;; Handle "-F" switch.
(when (string-match "F" switches)
(mapc
(lambda (x)
(when (not (zerop (length (car x))))
(cond
((char-equal ?d (string-to-char (nth 9 x)))
(setcar x (concat (car x) "/")))
((char-equal ?x (string-to-char (nth 9 x)))
(setcar x (concat (car x) "*"))))))
entries))
;; Print entries.
(mapcar
(lambda (x)
(when (not (zerop (length (nth 0 x))))
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
(nth 9 x) ; mode
(nth 11 x) ; inode
(nth 3 x) ; uid
(nth 4 x) ; gid
(nth 8 x) ; size
(format-time-string
(if (tramp-time-less-p
(tramp-time-subtract (current-time) (nth 6 x))
tramp-half-a-year)
"%b %e %R"
"%b %e %Y")
(nth 6 x)))) ; date
;; For the file name, we set the `dired-filename'
;; property. This allows to handle file names with
;; leading or trailing spaces as well. The inserted name
;; could be from somewhere else, so we use the relative
;; file name of `default-directory'.
(let ((pos (point)))
(insert
(format
"%s\n"
(file-relative-name
(expand-file-name (nth 0 x) (file-name-directory filename)))))
(put-text-property pos (1- (point)) 'dired-filename t))
(forward-line)
(beginning-of-line)))
entries)))))
(defun tramp-imap-handle-insert-file-contents
(filename &optional visit beg end replace)
"Like `insert-file-contents' for Tramp files."
(barf-if-buffer-read-only)
(when visit
(setq buffer-file-name (expand-file-name filename))
(set-visited-file-modtime)
(set-buffer-modified-p nil))
(with-parsed-tramp-file-name filename nil
(if (not (file-exists-p filename))
(tramp-error
v 'file-error "File `%s' not found on remote host" filename)
(let ((point (point))
size data)
(with-progress-reporter v 3 (format "Fetching file %s" filename)
(insert (tramp-imap-get-file filename t))
(setq size (- (point) point))
;;; TODO: handle ranges.
;;; (let ((beg (or beg (point-min)))
;;; (end (min (or end (point-max)) (point-max))))
;;; (setq size (- end beg))
;;; (buffer-substring beg end))
(goto-char point)
(list (expand-file-name filename) size))))))
(defun tramp-imap-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp-IMAP files."
;; We allow only mailboxes to be a directory.
(with-parsed-tramp-file-name (expand-file-name filename default-directory) nil
(and (string-match "^/[^/]*$" (directory-file-name localname)) t)))
(defun tramp-imap-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp-IMAP FILENAME."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(let ((res (cdr-safe (nth 0 (tramp-imap-get-file-entries v localname)))))
(unless (or (null res) (eq id-format 'string))
(setcar (nthcdr 2 res) 1)
(setcar (nthcdr 3 res) 1))
res)))
(defun tramp-imap-get-file-inode (filename &optional id-format)
"Get inode equivalent \(actually the UID) for Tramp-IMAP FILENAME."
(nth 10 (tramp-compat-file-attributes filename id-format)))
(defun tramp-imap-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files. True for IMAP."
;; `file-exists-p' does not work yet for directories.
;; (file-exists-p (file-name-directory filename)))
(file-directory-p (file-name-directory filename)))
(defun tramp-imap-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(cond
((not (file-exists-p filename)) nil)
(t (with-parsed-tramp-file-name (expand-file-name filename) nil
(let ((iht (tramp-imap-make-iht v)))
(imap-hash-rem (tramp-imap-get-file-inode filename) iht))))))
(defun tramp-imap-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(unless (file-exists-p filename)
(tramp-error
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(with-temp-buffer
(insert-file-contents filename)
(write-region (point-min) (point-max) tmpfile)
tmpfile)))))
(defun tramp-imap-put-file
(vec filename-or-buffer &optional subject inode encode size)
"Write contents of FILENAME-OR-BUFFER to Tramp-IMAP file VEC with name SUBJECT.
When INODE is given, delete that old remote file after writing the new one
\(normally this is the old file with the same name). A non-nil ENCODE
forces the encoding of the buffer or file. SIZE, when available, indicates
the file size; this is needed, if the file or buffer is already encoded."
;; `tramp-current-host' is used in `tramp-imap-passphrase-callback-function'.
(let ((tramp-current-host (tramp-file-name-real-host vec))
(iht (tramp-imap-make-iht vec)))
(imap-hash-put (list
(list (cons
'Subject
(format
"%s%s"
tramp-imap-subject-marker
(or subject "no subject")))
(cons
'X-Size
(number-to-string
(cond
((numberp size) size)
((bufferp filename-or-buffer)
(buffer-size filename-or-buffer))
((stringp filename-or-buffer)
(nth 7 (file-attributes filename-or-buffer)))
;; We don't know the size.
(t -1)))))
(cond ((bufferp filename-or-buffer)
(with-current-buffer filename-or-buffer
(if encode
(tramp-imap-encode-buffer)
(buffer-string))))
;; TODO: allow file names.
(t "No body available")))
iht
inode)))
(defun tramp-imap-get-file (filename &optional decode)
;; (debug (tramp-imap-get-file-inode filename))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(condition-case ()
;; `tramp-current-host' is used in
;; `tramp-imap-passphrase-callback-function'.
(let* ((tramp-current-host (tramp-file-name-real-host v))
(iht (tramp-imap-make-iht v))
(inode (tramp-imap-get-file-inode filename))
(data (imap-hash-get inode iht t)))
(if decode
(with-temp-buffer
(insert (nth 1 data))
;;(debug inode (buffer-string))
(tramp-imap-decode-buffer))
(nth 1 data)))
(error (tramp-error
v 'file-error "File `%s' could not be read" filename)))))
(defun tramp-imap-passphrase-callback-function (context key-id handback)
"Called by EPG to get a passphrase for Tramp-IMAP.
CONTEXT is the encryption/decryption EPG context.
HANDBACK is just carried through.
KEY-ID can be 'SYM or 'PIN among others."
(let* ((server tramp-current-host)
(port "tramp-imap") ; this is NOT the server password!
(auth-passwd (plist-get
(nth 0 (auth-source-search :max 1
:host server
:port port))
:secret))
(auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd)))
(or
(copy-sequence auth-passwd)
;; If we cache the passphrase and we have one.
(if (and (eq tramp-imap-passphrase-cache t)
tramp-imap-passphrase)
;; Do we reuse it?
(if (y-or-n-p "Reuse the passphrase? ")
(copy-sequence tramp-imap-passphrase)
;; Don't reuse: revert caching behavior to nil, erase passphrase,
;; call ourselves again.
(setq tramp-imap-passphrase-cache nil)
(setq tramp-imap-passphrase nil)
(tramp-imap-passphrase-callback-function context key-id handback))
(let ((p (if (eq key-id 'SYM)
(read-passwd
"Tramp-IMAP passphrase for symmetric encryption: "
(eq (epg-context-operation context) 'encrypt)
tramp-imap-passphrase)
(read-passwd
(if (eq key-id 'PIN)
"Tramp-IMAP passphrase for PIN: "
(let ((entry (assoc key-id
(symbol-value 'epg-user-id-alist))))
(if entry
(format "Tramp-IMAP passphrase for %s %s: "
key-id (cdr entry))
(format "Tramp-IMAP passphrase for %s: " key-id))))
nil
tramp-imap-passphrase))))
;; If we have an answer, the passphrase has changed,
;; the user hasn't declined keeping the passphrase,
;; and they answer yes to keep it now...
(when (and
p
(not (equal tramp-imap-passphrase p))
(not (eq tramp-imap-passphrase-cache 'never))
(y-or-n-p "Keep the passphrase? "))
(setq tramp-imap-passphrase (copy-sequence p))
(setq tramp-imap-passphrase-cache t))
;; If we still don't have a passphrase, the user didn't want
;; to keep it.
(when (and
p
(not tramp-imap-passphrase))
(setq tramp-imap-passphrase-cache 'never))
p)))))
(defun tramp-imap-encode-buffer ()
(let ((context (epg-make-context 'OpenPGP))
cipher)
(epg-context-set-armor context t)
(epg-context-set-passphrase-callback context
#'tramp-imap-passphrase-callback-function)
(epg-context-set-progress-callback context
(cons #'epa-progress-callback-function
"Encrypting..."))
(message "Encrypting...")
(setq cipher (epg-encrypt-string
context
(encode-coding-string (buffer-string) 'utf-8)
nil))
(message "Encrypting...done")
cipher))
(defun tramp-imap-decode-buffer ()
(let ((context (epg-make-context 'OpenPGP))
plain)
(epg-context-set-passphrase-callback context
#'tramp-imap-passphrase-callback-function)
(epg-context-set-progress-callback context
(cons #'epa-progress-callback-function
"Decrypting..."))
(message "Decrypting...")
(setq plain (decode-coding-string
(epg-decrypt-string context (buffer-string))
'utf-8))
(message "Decrypting...done")
plain))
(defun tramp-imap-file-name-mailbox (vec)
(nth 0 (tramp-imap-file-name-parse vec)))
(defun tramp-imap-file-name-name (vec)
(nth 1 (tramp-imap-file-name-parse vec)))
(defun tramp-imap-file-name-localname (vec)
(nth 1 (tramp-imap-file-name-parse vec)))
(defun tramp-imap-file-name-parse (vec)
(let ((name (substring-no-properties (tramp-file-name-localname vec))))
(if (string-match "^/\\([^/]+\\)/?\\(.*\\)$" name)
(list (match-string 1 name)
(match-string 2 name))
nil)))
(defun tramp-imap-make-iht (vec &optional needed-subject)
"Translate the Tramp vector VEC to the imap-hash structure.
With NEEDED-SUBJECT, alters the imap-hash test accordingly."
(let* ((mbox (tramp-imap-file-name-mailbox vec))
(server (tramp-file-name-real-host vec))
(method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(ssl (string-equal method tramp-imaps-method))
(port (tramp-file-name-port vec))
(result (imap-hash-make server port mbox user nil ssl)))
;; Return the IHT with a test override to look for the subject
;; marker.
(plist-put
result
:test (format "^%s%s"
tramp-imap-subject-marker
(if needed-subject needed-subject "")))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-imap 'force)))
;;; TODO:
;; * Implement `tramp-imap-handle-delete-directory',
;; `tramp-imap-handle-make-directory',
;; `tramp-imap-handle-make-directory-internal',
;; `tramp-imap-handle-set-file-times'.
;; * Encode the subject. If the filename has trailing spaces (like
;; "test "), those characters get lost, for example in dired listings.
;; * When opening a dired buffer, like "/imap::INBOX.test", there are
;; several error messages:
;; "Buffer has a running process; kill it? (yes or no) "
;; "error in process filter: Internal error, tag 6 status BAD code nil text No mailbox selected."
;; Afterwards, everything seems to be fine.
;; * imaps works for local IMAP servers. Accessing
;; "/imaps:imap.gmail.com:/INBOX.test/" results in error
;; "error in process filter: Internal error, tag 5 status BAD code nil text UNSELECT not allowed now."
;; * Improve `tramp-imap-handle-file-attributes' for directories.
;; * Saving a file creates a second one, instead of overwriting.
;; * Backup files: just *one* is kept.
;; * Password requests shall have a descriptive prompt.
;; * Exiting Emacs, there are running IMAP processes. Make them quiet
;; by `set-process-query-on-exit-flag'.
(provide 'tramp-imap)
;;; tramp-imap.el ends here
;; Ignore, for testing only.
;;; (setq tramp-imap-subject-marker "T")
;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") t)
;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/") t)
;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4") t)
;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/") t)
;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t)
;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t t)
;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
;;; (dired-copy-file "/etc/fstab" "/imap:yourhosthere.com:/test/welcome" t)
;;; (write-region 1 100 "/imap:yourhosthere.com:/test/welcome")
;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome"))
;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome2"))
;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
;;(file-name-directory "/imap:yourhosthere.com:/test/welcome2")
;;(with-temp-buffer (insert "hello") (delete-file "/tmp/hellotest") (write-file "/tmp/hellotest") (write-file "/imap:yourhosthere.com:/test/welcome2"))
;;;(file-exists-p "/imap:yourhosthere.com:/INBOX.test/4")
;;;(file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
;;;(setq vec (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
;;; (tramp-imap-handle-insert-file-contents "/imap:user@yourhosthere.com:/INBOX.test/4" nil nil nil nil)
;;;(insert-file-contents "/imap:yourhosthere.com:/INBOX.test/4")
;;;(file-attributes "/imap:yourhosthere.com:/test/welcommen")
;;;(insert-file-contents "/imap:yourhosthere.com:/test/welcome")
;;;(file-exists-p "/imap:yourhosthere.com:/test/welcome2")
;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/test/welcome")
;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcommen")
;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
;;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
;;; (delete-file "/imap:yourhosthere.com:/test/welcome")
;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcommen" t)
;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test"))
;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/old"))
;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new"))
;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/two"))
;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/one"))
;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test"))
;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4"))
;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/"))
;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") "extra")

15
lisp/net/tramp.el
View file

@ -3526,23 +3526,24 @@ Invokes `password-read' if available, `read-passwd' else."
(with-parsed-tramp-file-name key nil
(prog1
(or
;; See if auth-sources contains something useful, if it's bound.
;; See if auth-sources contains something useful, if it's
;; bound. `auth-source-user-or-password' is an obsoleted
;; function, it has been replaced by `auth-source-search'.
(and (boundp 'auth-sources)
(tramp-get-connection-property v "first-password-request" nil)
;; Try with Tramp's current method.
(if (fboundp 'auth-source-search)
(progn
(setq auth-info
(setq auth-info
(tramp-compat-funcall
'auth-source-search
:max 1
:user (or tramp-current-user t)
:host tramp-current-host
:port tramp-current-method))
(setq auth-passwd (plist-get (nth 0 auth-info) :secret))
(setq auth-passwd (if (functionp auth-passwd)
:port tramp-current-method)
auth-passwd (plist-get (nth 0 auth-info) :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd)))
auth-passwd))
(tramp-compat-funcall
'auth-source-user-or-password
"password" tramp-current-host tramp-current-method)))

7
lisp/password-cache.el
View file

@ -111,9 +111,10 @@ that a password is invalid, so that `password-read' query the
user again."
(let ((password (symbol-value (intern-soft key password-data))))
(when password
(if (fboundp 'clear-string)
(clear-string password)
(fillarray password ?_))
(when (stringp password)
(if (fboundp 'clear-string)
(clear-string password)
(fillarray password ?_)))
(unintern key password-data))))
(defun password-cache-add (key password)

88
lisp/progmodes/cc-engine.el
View file

@ -5371,8 +5371,6 @@ comment at the start of cc-engine.el for more info."
;; cc-mode requires cc-fonts.
(declare-function c-fontify-recorded-types-and-refs "cc-fonts" ())
(defvar c-forward-<>-arglist-recur-depth)
(defun c-forward-<>-arglist (all-types)
;; The point is assumed to be at a "<". Try to treat it as the open
;; paren of an angle bracket arglist and move forward to the
@ -5398,8 +5396,7 @@ comment at the start of cc-engine.el for more info."
;; If `c-record-type-identifiers' is set then activate
;; recording of any found types that constitute an argument in
;; the arglist.
(c-record-found-types (if c-record-type-identifiers t))
(c-forward-<>-arglist-recur--depth 0))
(c-record-found-types (if c-record-type-identifiers t)))
(if (catch 'angle-bracket-arglist-escape
(setq c-record-found-types
(c-forward-<>-arglist-recur all-types)))
@ -5416,14 +5413,6 @@ comment at the start of cc-engine.el for more info."
nil)))
(defun c-forward-<>-arglist-recur (all-types)
;; Temporary workaround for Bug#7722.
(when (boundp 'c-forward-<>-arglist-recur--depth)
(if (> c-forward-<>-arglist-recur--depth 200)
(error "Max recursion depth reached in <> arglist")
(setq c-forward-<>-arglist-recur--depth
(1+ c-forward-<>-arglist-recur--depth))))
;; Recursive part of `c-forward-<>-arglist'.
;;
;; This function might do hidden buffer changes.
@ -5455,9 +5444,11 @@ comment at the start of cc-engine.el for more info."
(goto-char start)
nil))
(forward-char)
(forward-char) ; Forward over the opening '<'.
(unless (looking-at c-<-op-cont-regexp)
;; go forward one non-alphanumeric character (group) per iteration of
;; this loop.
(while (and
(progn
(c-forward-syntactic-ws)
@ -5486,7 +5477,7 @@ comment at the start of cc-engine.el for more info."
(c-forward-type)
(c-forward-syntactic-ws))))))
(setq pos (point))
(setq pos (point)) ; e.g. first token inside the '<'
;; Note: These regexps exploit the match order in \| so
;; that "<>" is matched by "<" rather than "[^>:-]>".
@ -5522,37 +5513,35 @@ comment at the start of cc-engine.el for more info."
;; Either an operator starting with '<' or a nested arglist.
(setq pos (point))
(let (id-start id-end subres keyword-match)
(if (if (looking-at c-<-op-cont-regexp)
(setq tmp (match-end 0))
(setq tmp pos)
(backward-char)
(not
(and
(save-excursion
;; There's always an identifier before an angle
;; bracket arglist, or a keyword in
;; `c-<>-type-kwds' or `c-<>-arglist-kwds'.
(c-backward-syntactic-ws)
(setq id-end (point))
(c-simple-skip-symbol-backward)
(when (or (setq keyword-match
(looking-at c-opt-<>-sexp-key))
(not (looking-at c-keywords-regexp)))
(setq id-start (point))))
(setq subres
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-<>-arglist-recur
(and keyword-match
(c-keyword-member
(c-keyword-sym (match-string 1))
'c-<>-type-kwds)))))
)))
;; It was not an angle bracket arglist.
(goto-char tmp)
(cond
;; The '<' begins a multi-char operator.
((looking-at c-<-op-cont-regexp)
(setq tmp (match-end 0))
(goto-char (match-end 0)))
;; We're at a nested <.....>
((progn
(setq tmp pos)
(backward-char) ; to the '<'
(and
(save-excursion
;; There's always an identifier before an angle
;; bracket arglist, or a keyword in `c-<>-type-kwds'
;; or `c-<>-arglist-kwds'.
(c-backward-syntactic-ws)
(setq id-end (point))
(c-simple-skip-symbol-backward)
(when (or (setq keyword-match
(looking-at c-opt-<>-sexp-key))
(not (looking-at c-keywords-regexp)))
(setq id-start (point))))
(setq subres
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-<>-arglist-recur
(and keyword-match
(c-keyword-member
(c-keyword-sym (match-string 1))
'c-<>-type-kwds)))))))
;; It was an angle bracket arglist.
(setq c-record-found-types subres)
@ -5567,8 +5556,13 @@ comment at the start of cc-engine.el for more info."
(c-forward-syntactic-ws)
(looking-at c-opt-identifier-concat-key)))
(c-record-ref-id (cons id-start id-end))
(c-record-type-id (cons id-start id-end))))))
t)
(c-record-type-id (cons id-start id-end)))))
;; At a "less than" operator.
(t
(forward-char)
)))
t) ; carry on looping.
((and (not c-restricted-<>-arglists)
(or (and (eq (char-before) ?&)

11
lisp/progmodes/cc-fonts.el
View file

@ -1082,7 +1082,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(boundp 'parse-sexp-lookup-properties))))
;; Below we fontify a whole declaration even when it crosses the limit,
;; to avoid gaps when lazy-lock fontifies the file a screenful at a
;; to avoid gaps when jit/lazy-lock fontifies the file a block at a
;; time. That is however annoying during editing, e.g. the following is
;; a common situation while the first line is being written:
;;
@ -1094,9 +1094,9 @@ casts and declarations are fontified. Used on level 2 and higher."
;; "some_other_variable" as an identifier, and the latter will not
;; correct itself until the second line is changed. To avoid that we
;; narrow to the limit if the region to fontify is a single line.
(narrow-to-region
(point-min)
(if (<= limit (c-point 'bonl))
(if (<= limit (c-point 'bonl))
(narrow-to-region
(point-min)
(save-excursion
;; Narrow after any operator chars following the limit though,
;; since those characters can be useful in recognizing a
@ -1104,8 +1104,7 @@ casts and declarations are fontified. Used on level 2 and higher."
;; after the header).
(goto-char limit)
(skip-chars-forward c-nonsymbol-chars)
(point))
limit))
(point))))
(c-find-decl-spots
limit

4
lisp/simple.el
View file

@ -304,8 +304,8 @@ runs `next-error-hook' with `run-hooks', and stays with that buffer
until you use it in some other buffer which uses Compilation mode
or Compilation Minor mode.
See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
(interactive "P")
(if (consp arg) (setq reset t arg nil))
(when (setq next-error-last-buffer (next-error-find-buffer))

2
lisp/textmodes/reftex-index.el
View file

@ -1957,7 +1957,7 @@ both ends."
((equal char ?\C-g)
(keyboard-quit))
((member char '(?o ?O))
;; Select a differnt macro
;; Select a different macro
(let* ((nc (reftex-index-select-phrases-macro 2))
(macro-data
(cdr (assoc nc reftex-index-phrases-macro-data)))

2
lisp/vc/ediff-mult.el
View file

@ -306,7 +306,7 @@ buffers."
(nth 3 elt))
(defsubst ediff-get-session-objC (elt)
(nth 4 elt))
;; Take the "name" component of the object into acount. ObjA/C/B is of the form
;; Take the "name" component of the object into account. ObjA/C/B is of the form
;; (name . equality-indicator)
(defsubst ediff-get-session-objA-name (elt)
(car (nth 2 elt)))

2
lisp/vc/ediff-ptch.el
View file

@ -417,7 +417,7 @@ Ediff has inferred that
are two possible targets for applying the patch.
Both files seem to be plausible alternatives.
Please advice:
Please advise:
Type `y' to use %s as the target;
Type `n' to use %s as the target.
"

194
lisp/vc/log-view.el
View file

@ -130,6 +130,7 @@
("z" . kill-this-buffer)
("q" . quit-window)
("g" . revert-buffer)
("\C-m" . log-view-toggle-entry-display)
("m" . log-view-toggle-mark-entry)
("e" . log-view-modify-change-comment)
@ -147,7 +148,6 @@
("\M-n" . log-view-file-next)
("\M-p" . log-view-file-prev))
"Log-View's keymap."
:inherit widget-keymap
:group 'log-view)
(easy-menu-define log-view-mode-menu log-view-mode-map
@ -168,6 +168,8 @@
:help "Annotate the version at point"]
["Modify Log Comment" log-view-modify-change-comment
:help "Edit the change comment displayed at point"]
["Toggle Details at Point" log-view-toggle-entry-display
:active log-view-expanded-log-entry-function]
"-----"
["Next Log Entry" log-view-msg-next
:help "Go to the next count'th log message"]
@ -181,6 +183,12 @@
(defvar log-view-mode-hook nil
"Hook run at the end of `log-view-mode'.")
(defvar log-view-expanded-log-entry-function nil
"Function returning the detailed description of a Log View entry.
It is called by the command `log-view-toggle-entry-display' with
one arg, the revision tag (a string), and should return a string.
If it is nil, `log-view-toggle-entry-display' does nothing.")
(defface log-view-file
'((((class color) (background light))
(:background "grey70" :weight bold))
@ -300,15 +308,36 @@ The match group number 1 should match the revision number itself.")
(when cvsdir (setq dir (expand-file-name cvsdir dir))))
(expand-file-name file dir))))
(defun log-view-current-tag (&optional where)
(save-excursion
(when where (goto-char where))
(forward-line 1)
(let ((pt (point)))
(when (re-search-backward log-view-message-re nil t)
(let ((rev (match-string-no-properties 1)))
(unless (re-search-forward log-view-file-re pt t)
rev))))))
(defun log-view-current-entry (&optional pos move)
"Return the position and revision tag of the Log View entry at POS.
This is a list (BEG TAG), where BEG is a buffer position and TAG
is a string. If POS is nil or omitted, it defaults to point.
If there is no entry at POS, return nil.
If optional arg MOVE is non-nil, move point to BEG if found.
Otherwise, don't move point."
(let ((looping t)
result)
(save-excursion
(when pos (goto-char pos))
(forward-line 1)
(while looping
(setq pos (re-search-backward log-view-message-re nil 'move)
looping (and pos (log-view-inside-comment-p (point)))))
(when pos
(setq result
(list pos (match-string-no-properties 1)))))
(and move result (goto-char pos))
result))
(defun log-view-inside-comment-p (pos)
"Return non-nil if POS lies inside an expanded log entry."
(eq (get-text-property pos 'log-view-comment) t))
(defun log-view-current-tag (&optional pos)
"Return the revision tag (a string) of the Log View entry at POS.
if POS is omitted or nil, it defaults to point."
(cadr (log-view-current-entry pos)))
(defun log-view-toggle-mark-entry ()
"Toggle the marked state for the log entry at point.
@ -318,29 +347,24 @@ entries are denoted by changing their background color.
log entries."
(interactive)
(save-excursion
(forward-line 1)
(let ((pt (point)))
(when (re-search-backward log-view-message-re nil t)
(let ((beg (match-beginning 0))
end ov ovlist found tag)
(unless (re-search-forward log-view-file-re pt t)
;; Look to see if the current entry is marked.
(setq found (get-char-property (point) 'log-view-self))
(if found
(delete-overlay found)
;; Create an overlay that covers this entry and change
;; its color.
(setq tag (log-view-current-tag (point)))
(forward-line 1)
(setq end
(if (re-search-forward log-view-message-re nil t)
(match-beginning 0)
(point-max)))
(setq ov (make-overlay beg end))
(overlay-put ov 'face 'log-view-file)
;; This is used to check if the overlay is present.
(overlay-put ov 'log-view-self ov)
(overlay-put ov 'log-view-marked tag))))))))
(let* ((entry (log-view-current-entry nil t))
(beg (car entry))
found)
(when entry
;; Look to see if the current entry is marked.
(setq found (get-char-property beg 'log-view-self))
(if found
(delete-overlay found)
;; Create an overlay covering this entry and change its color.
(let* ((end (if (get-text-property beg 'log-view-entry-expanded)
(next-single-property-change beg 'log-view-comment)
(log-view-end-of-defun)
(point)))
(ov (make-overlay beg end)))
(overlay-put ov 'face 'log-view-file)
;; This is used to check if the overlay is present.
(overlay-put ov 'log-view-self ov)
(overlay-put ov 'log-view-marked (nth 1 entry))))))))
(defun log-view-get-marked ()
"Return the list of tags for the marked log entries."
@ -353,50 +377,74 @@ log entries."
(setq pos (overlay-end ov))))
marked-list)))
(defun log-view-beginning-of-defun ()
;; This assumes that a log entry starts with a line matching
;; `log-view-message-re'. Modes that derive from `log-view-mode'
;; for which this assumption is not valid will have to provide
;; another implementation of this function. `log-view-msg-prev'
;; does a similar job to this function, we can't use it here
;; directly because it prints messages that are not appropriate in
;; this context and it does not move to the beginning of the buffer
;; when the point is before the first log entry.
(defun log-view-toggle-entry-display ()
(interactive)
;; Don't do anything unless `log-view-expanded-log-entry-function'
;; is defined in this mode.
(when (functionp log-view-expanded-log-entry-function)
(let* ((opoint (point))
(entry (log-view-current-entry nil t))
(beg (car entry))
(buffer-read-only nil))
(when entry
(if (get-text-property beg 'log-view-entry-expanded)
;; If the entry is expanded, collapse it.
(let ((pos (next-single-property-change beg 'log-view-comment)))
(unless (and pos (log-view-inside-comment-p pos))
(error "Broken markup in `log-view-toggle-entry-display'"))
(delete-region pos
(next-single-property-change pos 'log-view-comment))
(put-text-property beg (1+ beg) 'log-view-entry-expanded nil)
(if (< opoint pos)
(goto-char opoint)))
;; Otherwise, expand the entry.
(let ((long-entry (funcall log-view-expanded-log-entry-function
(nth 1 entry))))
(when long-entry
(put-text-property beg (1+ beg) 'log-view-entry-expanded t)
(log-view-end-of-defun)
(setq beg (point))
(insert long-entry "\n")
(add-text-properties
beg (point)
'(font-lock-face font-lock-comment-face log-view-comment t))
(goto-char opoint))))))))
;; `log-view-beginning-of-defun' and `log-view-end-of-defun' have
;; been checked to work with logs produced by RCS, CVS, git,
;; mercurial and subversion.
(defun log-view-beginning-of-defun (&optional arg)
"Move backward to the beginning of a Log View entry.
With ARG, do it that many times. Negative ARG means move forward
to the beginning of the ARGth following entry.
(re-search-backward log-view-message-re nil 'move))
This is Log View mode's default `beginning-of-defun-function'.
It assumes that a log entry starts with a line matching
`log-view-message-re'."
(if (or (null arg) (zerop arg))
(setq arg 1))
(if (< arg 0)
(dotimes (n (- arg))
(log-view-end-of-defun))
(catch 'beginning-of-buffer
(dotimes (n arg)
(or (log-view-current-entry nil t)
(throw 'beginning-of-buffer nil)))
(point))))
(defun log-view-end-of-defun ()
;; The idea in this function is to search for the beginning of the
;; next log entry using `log-view-message-re' and then go back one
;; line when finding it. Modes that derive from `log-view-mode' for
;; which this assumption is not valid will have to provide another
;; implementation of this function.
;; Look back and if there is no entry there it means we are before
;; the first log entry, so go forward until finding one.
(unless (save-excursion (re-search-backward log-view-message-re nil t))
(re-search-forward log-view-message-re nil t))
;; In case we are at the end of log entry going forward a line will
;; make us find the next entry when searching. If we are inside of
;; an entry going forward a line will still keep the point inside
;; the same entry.
(forward-line 1)
;; In case we are at the beginning of an entry, move past it.
(when (looking-at log-view-message-re)
(goto-char (match-end 0))
(forward-line 1))
;; Search for the start of the next log entry. Go to the end of the
;; buffer if we could not find a next entry.
(when (re-search-forward log-view-message-re nil 'move)
(goto-char (match-beginning 0))
(forward-line -1)))
"Move forward to the next Log View entry."
(let ((looping t))
(if (looking-at log-view-message-re)
(goto-char (match-end 0)))
(while looping
(cond
((re-search-forward log-view-message-re nil 'move)
(unless (log-view-inside-comment-p (point))
(setq looping nil)
(goto-char (match-beginning 0))))
;; Don't advance past the end buttons inserted by
;; `vc-print-log-setup-buttons'.
((looking-back "Show 2X entries Show unlimited entries")
(setq looping nil)
(forward-line -1))))))
(defvar cvs-minor-current-files)
(defvar cvs-branch-prefix)

16
lisp/vc/vc-bzr.el
View file

@ -590,6 +590,7 @@ REV non-nil gets an error."
(defvar log-view-font-lock-keywords)
(defvar log-view-current-tag-function)
(defvar log-view-per-file-logs)
(defvar log-view-expanded-log-entry-function)
(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
(remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
@ -600,6 +601,11 @@ REV non-nil gets an error."
(if (eq vc-log-view-type 'short)
"^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
"^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
'vc-bzr-expanded-log-entry))
(set (make-local-variable 'log-view-font-lock-keywords)
;; log-view-font-lock-keywords is careful to use the buffer-local
;; value of log-view-message-re only since Emacs-23.
@ -637,6 +643,16 @@ REV non-nil gets an error."
(list vc-bzr-log-switches)
vc-bzr-log-switches)))))
(defun vc-bzr-expanded-log-entry (revision)
(with-temp-buffer
(apply 'vc-bzr-command "log" t nil nil
(list (format "-r%s" revision)))
(goto-char (point-min))
(when (looking-at "^-+\n")
;; Indent the expanded log entry.
(indent-region (match-end 0) (point-max) 2)
(buffer-substring (match-end 0) (point-max)))))
(defun vc-bzr-log-incoming (buffer remote-location)
(apply 'vc-bzr-command "missing" buffer 'async nil
(list "--theirs-only" (unless (string= remote-location "") remote-location))))

101
lisp/vc/vc-git.el
View file

@ -119,6 +119,27 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:version "23.1"
:group 'vc)
(defcustom vc-git-root-log-format
'("%d%h..: %an %ad %s"
;; The first shy group matches the characters drawn by --graph.
;; We use numbered groups because `log-view-message-re' wants the
;; revision number to be group 1.
"^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \
\\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
((1 'log-view-message-face)
(2 'change-log-list nil lax)
(3 'change-log-name)
(4 'change-log-date)))
"Git log format for `vc-print-root-log'.
This should be a list (FORMAT REGEXP KEYWORDS), where FORMAT is a
format string (which is passed to \"git log\" via the argument
\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
matching the resulting Git log output, and KEYWORDS is a list of
`font-lock-keywords' for highlighting the Log View buffer."
:type '(list string string (repeat sexp))
:group 'vc
:version "24.1")
(defvar vc-git-commits-coding-system 'utf-8
"Default coding system for git commits.")
@ -666,8 +687,10 @@ for the --graph option."
(append
'("log" "--no-color")
(when shortlog
'("--graph" "--decorate" "--date=short"
"--pretty=tformat:%d%h %ad %s" "--abbrev-commit"))
`("--graph" "--decorate" "--date=short"
,(format "--pretty=tformat:%s"
(car vc-git-root-log-format))
"--abbrev-commit"))
(when limit (list "-n" (format "%s" limit)))
(when start-revision (list start-revision))
'("--")))))))
@ -678,7 +701,8 @@ for the --graph option."
buffer 0 nil
"log"
"--no-color" "--graph" "--decorate" "--date=short"
"--pretty=tformat:%d%h %ad %s" "--abbrev-commit"
(format "--pretty=tformat:%s" (car vc-git-root-log-format))
"--abbrev-commit"
(concat (if (string= remote-location "")
"@{upstream}"
remote-location)
@ -689,9 +713,10 @@ for the --graph option."
(vc-git-command nil 0 nil "fetch")
(vc-git-command
buffer 0 nil
"log"
"log"
"--no-color" "--graph" "--decorate" "--date=short"
"--pretty=tformat:%d%h %ad %s" "--abbrev-commit"
(format "--pretty=tformat:%s" (car vc-git-root-log-format))
"--abbrev-commit"
(concat "HEAD.." (if (string= remote-location "")
"@{upstream}"
remote-location))))
@ -700,6 +725,7 @@ for the --graph option."
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
(defvar log-view-per-file-logs)
(defvar log-view-expanded-log-entry-function)
(define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
(require 'add-log) ;; We need the faces add-log.
@ -708,37 +734,37 @@ for the --graph option."
(set (make-local-variable 'log-view-per-file-logs) nil)
(set (make-local-variable 'log-view-message-re)
(if (not (eq vc-log-view-type 'long))
"^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
(cadr vc-git-root-log-format)
"^commit *\\([0-9a-z]+\\)"))
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
'vc-git-expanded-log-entry))
(set (make-local-variable 'log-view-font-lock-keywords)
(if (not (eq vc-log-view-type 'long))
'(
;; Same as log-view-message-re, except that we don't
;; want the shy group for the tag name.
("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
(1 'highlight nil lax)
(2 'change-log-acknowledgement)
(3 'change-log-date)))
(append
`((,log-view-message-re (1 'change-log-acknowledgement)))
;; Handle the case:
;; user: foo@bar
'(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-email))
;; Handle the case:
;; user: FirstName LastName <foo@bar>
("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-name))
("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgement)
(2 'change-log-acknowledgement))
("^Date: \\(.+\\)" (1 'change-log-date))
(list (cons (nth 1 vc-git-root-log-format)
(nth 2 vc-git-root-log-format)))
(append
`((,log-view-message-re (1 'change-log-acknowledgement)))
;; Handle the case:
;; user: foo@bar
'(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-email))
;; Handle the case:
;; user: FirstName LastName <foo@bar>
("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-name))
("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgement)
(2 'change-log-acknowledgement))
("^Date: \\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@ -758,6 +784,15 @@ or BRANCH^ (where \"^\" can be repeated)."
(t nil))))
(beginning-of-line)))
(defun vc-git-expanded-log-entry (revision)
(with-temp-buffer
(apply 'vc-git-command t nil nil (list "log" revision "-1"))
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
(indent-region (point-min) (point-max) 2)
(buffer-string))))
(defun vc-git-diff (files &optional rev1 rev2 buffer)
"Get a difference report using Git between two revisions of FILES."
(let (process-file-side-effects)

80
lisp/vc/vc-hg.el
View file

@ -138,6 +138,24 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
"Name of the Mercurial executable (excluding any arguments)."
:type 'string
:group 'vc)
(defcustom vc-hg-root-log-format
'("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n"
"^\\([0-9]+\\):\\([^:]*\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
((1 'log-view-message-face)
(2 'change-log-list)
(3 'change-log-name)
(4 'change-log-date)))
"Mercurial log template for `vc-print-root-log'.
This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE
is the \"--template\" argument string to pass to Mercurial,
REGEXP is a regular expression matching the resulting Mercurial
output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
:type '(list string string (repeat sexp))
:group 'vc
:version "24.1")
;;; Properties of the backend
@ -266,13 +284,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(nconc
(when start-revision (list (format "-r%s:" start-revision)))
(when limit (list "-l" (format "%s" limit)))
(when shortlog (list "--style" "compact"))
(when shortlog (list "--template" (car vc-hg-root-log-format)))
vc-hg-log-switches)))))
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
(defvar log-view-per-file-logs)
(defvar log-view-expanded-log-entry-function)
(define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
(require 'add-log) ;; we need the add-log faces
@ -280,33 +299,34 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(set (make-local-variable 'log-view-per-file-logs) nil)
(set (make-local-variable 'log-view-message-re)
(if (eq vc-log-view-type 'short)
"^\\([0-9]+\\)\\(\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$"
(cadr vc-hg-root-log-format)
"^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
'vc-hg-expanded-log-entry))
(set (make-local-variable 'log-view-font-lock-keywords)
(if (eq vc-log-view-type 'short)
(append `((,log-view-message-re
(1 'log-view-message-face)
(2 'highlight nil lax)
(3 'log-view-message-face)
(4 'change-log-date)
(5 'change-log-name))))
(append
log-view-font-lock-keywords
'(
;; Handle the case:
;; user: FirstName LastName <foo@bar>
("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
;; Handle the cases:
;; user: foo@bar
;; and
;; user: foo
("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
(1 'change-log-email))
("^date: \\(.+\\)" (1 'change-log-date))
("^tag: +\\([^ ]+\\)$" (1 'highlight))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
(list (cons (nth 1 vc-hg-root-log-format)
(nth 2 vc-hg-root-log-format)))
(append
log-view-font-lock-keywords
'(
;; Handle the case:
;; user: FirstName LastName <foo@bar>
("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
;; Handle the cases:
;; user: foo@bar
;; and
;; user: foo
("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
(1 'change-log-email))
("^date: \\(.+\\)" (1 'change-log-date))
("^tag: +\\([^ ]+\\)$" (1 'highlight))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
(defun vc-hg-diff (files &optional oldvers newvers buffer)
"Get a difference report using hg between two revisions of FILES."
@ -324,6 +344,16 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(list "-r" oldvers "-r" newvers)
(list "-r" oldvers)))))))
(defun vc-hg-expanded-log-entry (revision)
(with-temp-buffer
(vc-hg-command t nil nil "log" "-r" revision)
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
(indent-region (point-min) (point-max) 2)
(goto-char (point-max))
(buffer-string))))
(defun vc-hg-revision-table (files)
(let ((default-directory (file-name-directory (car files))))
(with-temp-buffer

30
lisp/vc/vc.el
View file

@ -2014,22 +2014,20 @@ Not all VC backends support short logs!")
(goto-char (point-max))
(lexical-let ((working-revision working-revision)
(limit limit))
(widget-create 'push-button
:notify (lambda (&rest ignore)
(vc-print-log-internal
log-view-vc-backend log-view-vc-fileset
working-revision nil (* 2 limit)))
:help-echo "Show the log again, and double the number of log entries shown"
"Show 2X entries")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(vc-print-log-internal
log-view-vc-backend log-view-vc-fileset
working-revision nil nil))
:help-echo "Show the log again, showing all entries"
"Show unlimited entries"))
(widget-setup)))
(insert "\n")
(insert-text-button "Show 2X entries"
'action (lambda (&rest ignore)
(vc-print-log-internal
log-view-vc-backend log-view-vc-fileset
working-revision nil (* 2 limit)))
'help-echo "Show the log again, and double the number of log entries shown")
(insert " ")
(insert-text-button "Show unlimited entries"
'action (lambda (&rest ignore)
(vc-print-log-internal
log-view-vc-backend log-view-vc-fileset
working-revision nil nil))
'help-echo "Show the log again, including all entries"))))
(defun vc-print-log-internal (backend files working-revision
&optional is-start-revision limit)

33
lwlib/ChangeLog
View file

@ -1,3 +1,36 @@
2011-02-14 Jan Djärv <jan.h.d@swipnet.se>
* xlwmenu.h: Remove Xt[CN]faceName and Xt[NC]defaultFace.
* xlwmenuP.h (_XlwMenu_part): Remove faceName. Add fontName.
* xlwmenu.c (xlwmenu_default_font): Remove, does not work for
multi-display.
(xlwMenuResources): Remove XtNfaceName and XtNdefaultFace.
Make XtNFont a String resource.
(make_windows_if_needed): Call XFlush so later changes are seen by the
X server.
(remap_menubar): Use XtMoveWidget and then
XtResizeWidget/XtResizeWindow after XtPopup. Works better with
Compiz.
(make_drawing_gcs): Check if mw->menu.font is set.
(getDefaultXftFont): New function.
(openXftFont): faceName is now fontName. Try XLoadQueryFont first
and then XftFontOpenName.
(XlwMenuInitialize): Initialize mw->menu.font with XLoadQueryFont.
(XlwMenuClassInitialize): Remove initialization of
xlwmenu_default_font.
(fontname_changed): Renamed from facename_changed.
(XlwMenuSetValues): Use facename_changed.
* lwlib-Xaw.c (make_dialog): Use *font even for Xft fonts. Try
XLoadQueryFont first and then Xft fonts.
2011-02-13 Glenn Morris <rgm@gnu.org>
* lwlib-utils.c (index, rindex): Don't undef (neither used in lwlib/,
nor set in config.h).
2011-02-11 Glenn Morris <rgm@gnu.org>
* Makefile.in (USE_X_TOOLKIT, RM, TOOLKIT_DEFINES): Remove.

19
lwlib/lwlib-Xaw.c
View file

@ -577,13 +577,20 @@ make_dialog (char* name,
if (w)
{
XtResource rec[] =
{ { "faceName", "FaceName", XtRString, sizeof(String), 0, XtRString,
(XtPointer)"Sans-14" }};
char *faceName;
XtVaGetSubresources (dialog, &faceName, "Dialog", "dialog",
{ { "font", "Font", XtRString, sizeof(String), 0, XtRString,
(XtPointer)"Sans-10" }};
char *fontName = NULL;
XtVaGetSubresources (dialog, &fontName, "Dialog", "dialog",
rec, 1, (String)NULL);
if (strcmp ("none", faceName) != 0)
xft_font = openFont (dialog, faceName);
if (fontName)
{
XFontStruct *xfn = XLoadQueryFont (XtDisplay (dialog), fontName);
if (!xfn)
xft_font = openFont (dialog, fontName);
else
XFreeFont (XtDisplay (dialog), xfn);
}
if (xft_font)
{
instance->nr_xft_data = left_buttons + right_buttons + 1;

7
lwlib/lwlib-utils.c
View file

@ -24,13 +24,6 @@ Boston, MA 02110-1301, USA. */
#include <config.h>
#endif
/* Definitions of these in config.h can cause
declaration conflicts later on between declarations for index
and declarations for strchr. This file doesn't use
index and rindex, so cancel them. */
#undef index
#undef rindex
#include <setjmp.h>
#include <lisp.h>

87
lwlib/xlwmenu.c
View file

@ -71,8 +71,6 @@ extern char *gray_bitmap_bits;
static int pointer_grabbed;
static XEvent menu_post_event;
static XFontStruct *xlwmenu_default_font;
static char
xlwMenuTranslations [] =
"<BtnDown>: start()\n\
@ -131,14 +129,12 @@ xlwMenuResources[] =
offset(menu.fontSet), XtRFontSet, NULL},
#endif
#ifdef HAVE_XFT
#define DEFAULT_FACENAME "Sans-10"
{XtNfaceName, XtCFaceName, XtRString, sizeof(String),
offset(menu.faceName), XtRString, DEFAULT_FACENAME},
{XtNdefaultFace, XtCDefaultFace, XtRInt, sizeof(int),
offset(menu.default_face), XtRImmediate, (XtPointer)1},
#define DEFAULT_FONTNAME "Sans-10"
#else
#define DEFAULT_FONTNAME "XtDefaultFont"
#endif
{XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *),
offset(menu.font), XtRString, "XtDefaultFont"},
{XtNfont, XtCFont, XtRString, sizeof(String),
offset(menu.fontName), XtRString, DEFAULT_FONTNAME },
{XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel),
offset(menu.foreground), XtRString, "XtDefaultForeground"},
{XtNdisabledForeground, XtCDisabledForeground, XtRPixel, sizeof(Pixel),
@ -1352,6 +1348,7 @@ make_windows_if_needed (XlwMenuWidget mw, int n)
#endif
set_window_type (windows [i].w, mw);
}
XFlush (XtDisplay (mw));
}
/* Value is non-zero if WINDOW is part of menu bar widget W. */
@ -1534,10 +1531,12 @@ remap_menubar (XlwMenuWidget mw)
fit_to_screen (mw, ws, previous_ws, mw->menu.horizontal && i == 1);
XtVaSetValues (ws->w, XtNwidth, ws->width, XtNheight, ws->height,
XtNx, ws->x, XtNy, ws->y, NULL);
create_pixmap_for_menu (ws, mw);
XtMoveWidget (ws->w, ws->x, ws->y);
XtPopup (ws->w, XtGrabNone);
XtResizeWidget (ws->w, ws->width, ws->height,
mw->core.border_width);
XtResizeWindow (ws->w);
display_menu (mw, i, False, &selection_position, NULL, NULL);
}
@ -1613,14 +1612,17 @@ make_drawing_gcs (XlwMenuWidget mw)
XtGCMask mask = GCForeground | GCBackground;
#ifdef HAVE_X_I18N
if (!mw->menu.fontSet)
if (!mw->menu.fontSet && mw->menu.font)
{
xgcv.font = mw->menu.font->fid;
mask |= GCFont;
}
#else
xgcv.font = mw->menu.font->fid;
mask |= GCFont;
if (mw->menu.font)
{
xgcv.font = mw->menu.font->fid;
mask |= GCFont;
}
#endif
xgcv.foreground = mw->menu.foreground;
xgcv.background = mw->core.background_pixel;
@ -1847,13 +1849,20 @@ release_shadow_gcs (XlwMenuWidget mw)
}
#ifdef HAVE_XFT
static XftFont *
getDefaultXftFont (XlwMenuWidget mw)
{
int screen = XScreenNumberOfScreen (mw->core.screen);
return XftFontOpenName (XtDisplay (mw), screen, DEFAULT_FONTNAME);
}
static int
openXftFont (XlwMenuWidget mw)
{
char *fname = mw->menu.faceName;
char *fname = mw->menu.fontName;
mw->menu.xft_font = 0;
mw->menu.default_face = fname && strcmp (fname, DEFAULT_FACENAME) == 0;
mw->menu.default_face = fname && strcmp (fname, DEFAULT_FONTNAME) == 0;
if (fname && strcmp (fname, "none") != 0)
{
@ -1864,20 +1873,23 @@ openXftFont (XlwMenuWidget mw)
--i;
if (fname[i] == ' ')
{
fname = xstrdup (mw->menu.faceName);
fname = xstrdup (mw->menu.fontName);
fname[i] = '-';
}
mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, fname);
if (!mw->menu.xft_font)
mw->menu.font = XLoadQueryFont (XtDisplay (mw), fname);
if (!mw->menu.font)
{
fprintf (stderr, "Can't find font '%s'\n", fname);
mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen,
DEFAULT_FACENAME);
mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, fname);
if (!mw->menu.xft_font)
{
fprintf (stderr, "Can't find font '%s'\n", fname);
mw->menu.xft_font = getDefaultXftFont (mw);
}
}
}
if (fname != mw->menu.faceName) free (fname);
if (fname != mw->menu.fontName) free (fname);
return mw->menu.xft_font != 0;
}
@ -1913,19 +1925,19 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args)
;
else
#endif
if (!mw->menu.font)
{
if (!xlwmenu_default_font)
xlwmenu_default_font = XLoadQueryFont (display, "fixed");
mw->menu.font = xlwmenu_default_font;
if (!mw->menu.font)
mw->menu.font = XLoadQueryFont (display, mw->menu.fontName);
if (!mw->menu.font)
{
fprintf (stderr, "Menu font fixed not found, can't continue.\n");
abort ();
mw->menu.font = XLoadQueryFont (display, "fixed");
if (!mw->menu.font)
{
fprintf (stderr, "Menu font fixed not found, can't continue.\n");
abort ();
}
}
}
#ifdef HAVE_X_I18N
if (mw->menu.fontSet)
mw->menu.font_extents = XExtentsOfFontSet (mw->menu.fontSet);
@ -1966,7 +1978,6 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args)
static void
XlwMenuClassInitialize (void)
{
xlwmenu_default_font = 0;
}
static void
@ -2126,13 +2137,13 @@ XlwMenuDestroy (Widget w)
#ifdef HAVE_XFT
static int
facename_changed (XlwMenuWidget newmw,
fontname_changed (XlwMenuWidget newmw,
XlwMenuWidget oldmw)
{
/* This will fore a new XftFont even if the same string is set.
/* This will force a new XftFont even if the same string is set.
This is good, as rendering parameters may have changed and
we just want to do a redisplay. */
return newmw->menu.faceName != oldmw->menu.faceName;
return newmw->menu.fontName != oldmw->menu.fontName;
}
#endif
@ -2158,7 +2169,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new,
if (newmw->core.background_pixel != oldmw->core.background_pixel
|| newmw->menu.foreground != oldmw->menu.foreground
#ifdef HAVE_XFT
|| facename_changed (newmw, oldmw)
|| fontname_changed (newmw, oldmw)
#endif
#ifdef HAVE_X_I18N
|| newmw->menu.fontSet != oldmw->menu.fontSet
@ -2193,7 +2204,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new,
}
#ifdef HAVE_XFT
if (facename_changed (newmw, oldmw))
if (fontname_changed (newmw, oldmw))
{
int i;
int screen = XScreenNumberOfScreen (newmw->core.screen);

4
lwlib/xlwmenu.h
View file

@ -58,10 +58,6 @@ Boston, MA 02110-1301, USA. */
#define XtCResizeToPreferred "ResizeToPreferred"
#define XtNallowResize "allowResize"
#define XtCAllowResize "AllowResize"
#define XtNfaceName "faceName"
#define XtCFaceName "FaceName"
#define XtNdefaultFace "defaultFace"
#define XtCDefaultFace "DefaultFace"
/* Motif-compatible resource names */
#define XmNshadowThickness "shadowThickness"

2
lwlib/xlwmenuP.h
View file

@ -59,11 +59,11 @@ typedef struct _XlwMenu_part
XFontSetExtents *font_extents;
#endif
#ifdef HAVE_XFT
String faceName;
int default_face;
XftFont* xft_font;
XftColor xft_fg, xft_bg, xft_disabled_fg;
#endif
String fontName;
XFontStruct* font;
Pixel foreground;
Pixel disabled_foreground;

2
make-dist
View file

@ -359,7 +359,7 @@ echo "Making links to \`src'"
ln makefile.w32-in ../${tempdir}/src
ln .gdbinit .dbxinit ../${tempdir}/src
cd ../${tempdir}/src
rm -f config.h epaths.h Makefile buildobj.h)
rm -f globals.h config.h epaths.h Makefile buildobj.h)
echo "Making links to \`src/bitmaps'"
(cd src/bitmaps

208
src/ChangeLog
View file

@ -1,3 +1,207 @@
2011-02-15 Eli Zaretskii <eliz@gnu.org>
* nsfns.m (ns_set_name_as_filename, Fns_read_file_name): Use B_.
2011-02-14 Michael Welsh Duggan <md5i@md5i.com>
* print.c (float_to_string): Ensure that a decimal point is
printed if using dtoastr (Bug#8033).
2011-02-14 Eli Zaretskii <eliz@gnu.org>
* msdos.c (IT_frame_up_to_date):
* s/msdos.h (MODE_LINE_BINARY_TEXT): Use B_ for the MS-DOS build.
* dired.c (directory_files_internal):
* fileio.c (Finsert_file_contents):
* insdel.c (prepare_to_modify_buffer):
* xdisp.c (pos_visible_p):
* s/ms-w32.h (MODE_LINE_BINARY_TEXT):
* w32fns.c (Fw32_shell_execute, Fx_show_tip, x_create_tip_frame):
Use B_ for the MS-Windows build.
2011-02-14 Jan Djärv <jan.h.d@swipnet.se>
* xrdb.c (x_load_resources): For LUCID and XFT, don't put a
resource that specifies helvetica for menus and dialogs.
* xmenu.c (apply_systemfont_to_dialog): Apply to *dialog.font.
(apply_systemfont_to_menu): Set resources *menubar*font and
*popup*font. Remove defflt.
(set_frame_menubar, create_and_show_popup_menu): Call
apply_systemfont_to_menu before lw_create_widget.
2011-02-14 Tom Tromey <tromey@redhat.com>
* buffer.c (init_buffer_once, syms_of_buffer): Use B_ in DOS_NT case.
* keyboard.h: Remove obsolete comment.
2011-02-14 Tom Tromey <tromey@parfait>
* composite.c (fill_gstring_header)
(composition_compute_stop_pos, composition_adjust_point)
(Ffind_composition_internal): Use B_.
* intervals.c (set_point_both, get_local_map): Use B_.
* callproc.c (Fcall_process, Fcall_process_region): Use B_.
* process.c (get_process, list_processes_1, Fstart_process)
(Fmake_serial_process, Fmake_network_process)
(read_process_output, send_process, exec_sentinel)
(status_notify, setup_process_coding_systems): Use B_.
* bytecode.c (Fbyte_code): Use B_.
* syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table)
(Fset_syntax_table, Fmodify_syntax_entry, skip_chars)
(skip_syntaxes, scan_lists): Use B_.
* lread.c (readchar, unreadchar, openp, readevalloop)
(Feval_buffer, Feval_region): Use B_.
* print.c (printchar, strout, print_string, PRINTDECLARE)
(PRINTPREPARE, PRINTFINISH, temp_output_buffer_setup)
(print_object): Use B_.
* font.c (font_at): Use B_.
* fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): Use
B_.
* callint.c (check_mark, Fcall_interactively): Use B_.
* editfns.c (region_limit, Fmark_marker, save_excursion_save)
(save_excursion_restore, Fprevious_char, Fchar_before)
(general_insert_function, Finsert_char, Finsert_byte)
(make_buffer_string_both, Finsert_buffer_substring)
(Fcompare_buffer_substrings, subst_char_in_region_unwind)
(subst_char_in_region_unwind_1, Fsubst_char_in_region)
(Ftranslate_region_internal, save_restriction_restore)
(Fchar_equal): Use B_.
* data.c (swap_in_symval_forwarding, set_internal)
(Fmake_local_variable, Fkill_local_variable, Flocal_variable_p):
Use B_.
* undo.c (record_point, record_insert, record_delete)
(record_marker_adjustment, record_first_change)
(record_property_change, Fundo_boundary, truncate_undo_list)
(Fprimitive_undo): Use B_.
* search.c (compile_pattern_1, compile_pattern, looking_at_1)
(string_match_1, fast_looking_at, newline_cache_on_off)
(search_command, search_buffer, simple_search, boyer_moore)
(Freplace_match): Use B_.
* indent.c (buffer_display_table, recompute_width_table)
(width_run_cache_on_off, current_column, scan_for_column)
(Findent_to, position_indentation, compute_motion, vmotion): Use
B_.
* casefiddle.c (casify_object, casify_region): Use B_.
* casetab.c (Fcurrent_case_table, set_case_table): Use B_.
* cmds.c (Fself_insert_command, internal_self_insert): Use B_.
* fileio.c (Fexpand_file_name, Ffile_directory_p)
(Ffile_regular_p, Ffile_selinux_context)
(Fset_file_selinux_context, Ffile_modes, Fset_file_modes)
(Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind)
(Finsert_file_contents, choose_write_coding_system)
(Fwrite_region, build_annotations, Fverify_visited_file_modtime)
(Fset_visited_file_modtime, auto_save_error, auto_save_1)
(Fdo_auto_save, Fset_buffer_auto_saved): Use B_.
* minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Use B_.
* marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted)
(set_marker_both, set_marker_restricted_both, unchain_marker): Use
B_.
* insdel.c (check_markers, insert_char, insert_1_both)
(insert_from_string_1, insert_from_gap, insert_from_buffer_1)
(adjust_after_replace, replace_range, del_range_2)
(modify_region, prepare_to_modify_buffer)
(Fcombine_after_change_execute): Use B_.
* filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer)
(unlock_buffer): Use B_.
* keymap.c (Flocal_key_binding, Fuse_local_map)
(Fcurrent_local_map, push_key_description)
(Fdescribe_buffer_bindings): Use B_.
* keyboard.c (command_loop_1, read_char_minibuf_menu_prompt)
(read_key_sequence): Use B_.
* fringe.c (get_logical_cursor_bitmap)
(get_logical_fringe_bitmap, update_window_fringes): Use B_.
* xfns.c (x_create_tip_frame, Fx_show_tip): Use B_.
* xfaces.c (compute_char_face): Use B_.
* character.c (chars_in_text, Fget_byte): Use B_.
* category.c (check_category_table, Fcategory_table)
(Fset_category_table, char_category_set): Use B_.
* coding.c (decode_coding, encode_coding)
(make_conversion_work_buffer, decode_coding_gap)
(decode_coding_object, encode_coding_object)
(Fdetect_coding_region, Ffind_coding_systems_region_internal)
(Funencodable_char_position, Fcheck_coding_systems_region): Use
B_.
* charset.c (Ffind_charset_region): Use B_.
* window.c (window_display_table, unshow_buffer, window_loop)
(window_min_size_2, set_window_buffer, Fset_window_buffer)
(select_window, Fforce_window_update, temp_output_buffer_show)
(Fset_window_configuration, save_window_save): Use B_.
* xdisp.c (pos_visible_p, init_iterator, reseat_1)
(message_dolog, update_echo_area, ensure_echo_area_buffers)
(with_echo_area_buffer, setup_echo_area_for_printing)
(set_message_1, update_menu_bar, update_tool_bar)
(text_outside_line_unchanged_p, redisplay_internal)
(try_scrolling, try_cursor_movement, redisplay_window)
(try_window_reusing_current_matrix, row_containing_pos)
(try_window_id, get_overlay_arrow_glyph_row, display_line)
(Fcurrent_bidi_paragraph_direction, display_mode_lines)
(decode_mode_spec_coding, decode_mode_spec, display_count_lines)
(get_window_cursor_type, note_mouse_highlight): Use B_.
* frame.c (make_frame_visible_1): Use B_.
* dispnew.c (Fframe_or_buffer_changed_p): Use B_.
* dispextern.h (WINDOW_WANTS_HEADER_LINE_P)
(WINDOW_WANTS_MODELINE_P): Use B_.
* syntax.h (Vstandard_syntax_table): Update.
(CURRENT_SYNTAX_TABLE, SETUP_BUFFER_SYNTAX_TABLE): Use B_.
* intervals.h (TEXT_PROP_MEANS_INVISIBLE): Update.
(TEXT_PROP_MEANS_INVISIBLE): Use B_.
* character.h (FETCH_CHAR_ADVANCE): Update.
(INC_BOTH, ASCII_CHAR_WIDTH, DEC_BOTH): Use B_.
* category.h (Vstandard_category_table): Update.
* lisp.h (DEFVAR_BUFFER_DEFAULTS): Update for change to field
names.
(DOWNCASE_TABLE, UPCASE_TABLE): Use B_.
* buffer.c (swapfield_): New macro.
(Fbuffer_swap_text): Use swapfield_ where appropriate.
(Fbuffer_live_p, Fget_file_buffer, get_truename_buffer)
(Fget_buffer_create, clone_per_buffer_values)
(Fmake_indirect_buffer, reset_buffer)
(reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name)
(Fbuffer_local_value, buffer_lisp_local_variables)
(Fset_buffer_modified_p, Frestore_buffer_modified_p)
(Frename_buffer, Fother_buffer, Fbuffer_enable_undo)
(Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1)
(set_buffer_temp, Fset_buffer, set_buffer_if_live)
(Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer)
(Fbuffer_swap_text, Fset_buffer_multibyte)
(swap_out_buffer_local_variables, record_overlay_string)
(overlay_strings, init_buffer_once, init_buffer, syms_of_buffer):
Use B_.
* buffer.h (struct buffer): Rename all Lisp_Object fields.
(BUFFER_INTERNAL_FIELD, B_): New macro.
(FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE): Use B_.
2011-02-14 Jan Djärv <jan.h.d@swipnet.se>
* gtkutil.c (xg_tool_bar_menu_proxy): Handle case when tool bar label
is null.
2011-02-13 Jan Djärv <jan.h.d@swipnet.se>
* callproc.c (Fcall_process):
* process.c (create_process): Replace Gtk with GConf in SIGPIPE
comment.
2011-02-12 Martin Rudalics <rudalics@gmx.at>
* window.c (select_window): Check inhibit_point_swap argument when
deciding whether to return immediately.
2011-02-12 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (setFrame, initFrame): Make sure pixel_height doesn't become
zero (Bug#7348).
2011-02-12 Chong Yidong <cyd@stupidchicken.com>
* config.in (TERMINFO): New definition.
* s/netbsd.h: Use it to choose between terminfo and termcap
(Bug#7642).
2011-02-12 Paul Eggert <eggert@cs.ucla.edu>
* md5.c (md5_process_bytes): Use sizeof, not __alignof__.
@ -1636,7 +1840,7 @@
* gtkutil.c (menubar_map_cb): New function (Bug#7425).
(xg_update_frame_menubar): Connect signal map to menubar_map_cb.
Use 23 as menubar height if 0. (Bug#7425).
Use 23 as menubar height if 0. (Bug#7425).
2010-11-26 Eli Zaretskii <eliz@gnu.org>
@ -2643,7 +2847,7 @@
is more portable.
* keyboard.c (gobble_input): Move call of xd_read_queued_messages ...
(kbd_buffer_get_event): ... here. This is needed for cygwin, which
(kbd_buffer_get_event): ... here. This is needed for cygwin, which
has not defined SIGIO.
2010-10-08 Chong Yidong <cyd@stupidchicken.com>

16
src/alloc.c
View file

@ -3886,7 +3886,7 @@ live_buffer_p (struct mem_node *m, void *p)
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
&& !NILP (((struct buffer *) p)->name));
&& !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name)));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
@ -4872,11 +4872,11 @@ returns nil, because real GC can't be done. */)
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt))
if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
truncate_undo_list (nextb);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
if (nextb->base_buffer == 0 && !NILP (nextb->name)
if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
&& ! nextb->text->inhibit_shrinking)
{
/* If a buffer's gap size is more than 10% of the buffer
@ -5009,10 +5009,10 @@ returns nil, because real GC can't be done. */)
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! EQ (nextb->undo_list, Qt))
if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
{
Lisp_Object tail, prev;
tail = nextb->undo_list;
tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
prev = Qnil;
while (CONSP (tail))
{
@ -5021,7 +5021,7 @@ returns nil, because real GC can't be done. */)
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
{
if (NILP (prev))
nextb->undo_list = tail = XCDR (tail);
nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
else
{
tail = XCDR (tail);
@ -5037,7 +5037,7 @@ returns nil, because real GC can't be done. */)
}
/* Now that we have stripped the elements that need not be in the
undo_list any more, we can finally mark the list. */
mark_object (nextb->undo_list);
mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
nextb = nextb->next;
}
@ -5595,7 +5595,7 @@ mark_buffer (Lisp_Object buf)
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
for (ptr = &buffer->name;
for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr++)
mark_object (*ptr);

686
src/buffer.c
View file

File diff suppressed because it is too large Load diff

151
src/buffer.h
View file

@ -321,7 +321,7 @@ while (0)
/* Return character at byte position POS. */
#define FETCH_CHAR(pos) \
(!NILP (current_buffer->enable_multibyte_characters) \
(!NILP (B_ (current_buffer, enable_multibyte_characters)) \
? FETCH_MULTIBYTE_CHAR ((pos)) \
: FETCH_BYTE ((pos)))
@ -346,7 +346,7 @@ extern unsigned char *_fetch_multibyte_char_p;
multibyte. */
#define FETCH_CHAR_AS_MULTIBYTE(pos) \
(!NILP (current_buffer->enable_multibyte_characters) \
(!NILP (B_ (current_buffer, enable_multibyte_characters)) \
? FETCH_MULTIBYTE_CHAR ((pos)) \
: UNIBYTE_TO_CHAR (FETCH_BYTE ((pos))))
@ -464,6 +464,15 @@ struct buffer_text
int inhibit_shrinking;
};
/* Lisp fields in struct buffer are hidden from most code and accessed
via the B_ macro, below. Only select pieces of code, like the GC,
are allowed to use BUFFER_INTERNAL_FIELD. */
#define BUFFER_INTERNAL_FIELD(field) field ## _
/* Most code should use this macro to access Lisp fields in struct
buffer. */
#define B_(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field))
/* This is the structure that the buffer Lisp object points to. */
struct buffer
@ -587,138 +596,138 @@ struct buffer
because local variables have to be right in the struct buffer.
So we copy it around in set_buffer_internal.
This comes before `name' because it is marked in a special way. */
Lisp_Object undo_list;
Lisp_Object BUFFER_INTERNAL_FIELD (undo_list);
/* The name of this buffer. */
Lisp_Object name;
Lisp_Object BUFFER_INTERNAL_FIELD (name);
/* The name of the file visited in this buffer, or nil. */
Lisp_Object filename;
Lisp_Object BUFFER_INTERNAL_FIELD (filename);
/* Dir for expanding relative file names. */
Lisp_Object directory;
Lisp_Object BUFFER_INTERNAL_FIELD (directory);
/* True if this buffer has been backed up (if you write to the
visited file and it hasn't been backed up, then a backup will
be made). */
/* This isn't really used by the C code, so could be deleted. */
Lisp_Object backed_up;
Lisp_Object BUFFER_INTERNAL_FIELD (backed_up);
/* Length of file when last read or saved.
-1 means auto saving turned off because buffer shrank a lot.
-2 means don't turn off auto saving if buffer shrinks.
(That value is used with buffer-swap-text.)
This is not in the struct buffer_text
because it's not used in indirect buffers at all. */
Lisp_Object save_length;
Lisp_Object BUFFER_INTERNAL_FIELD (save_length);
/* File name used for auto-saving this buffer.
This is not in the struct buffer_text
because it's not used in indirect buffers at all. */
Lisp_Object auto_save_file_name;
Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_name);
/* Non-nil if buffer read-only. */
Lisp_Object read_only;
Lisp_Object BUFFER_INTERNAL_FIELD (read_only);
/* "The mark". This is a marker which may
point into this buffer or may point nowhere. */
Lisp_Object mark;
Lisp_Object BUFFER_INTERNAL_FIELD (mark);
/* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) for all
per-buffer variables of this buffer. For locally unbound
symbols, just the symbol appears as the element. */
Lisp_Object local_var_alist;
Lisp_Object BUFFER_INTERNAL_FIELD (local_var_alist);
/* Symbol naming major mode (eg, lisp-mode). */
Lisp_Object major_mode;
Lisp_Object BUFFER_INTERNAL_FIELD (major_mode);
/* Pretty name of major mode (eg, "Lisp"). */
Lisp_Object mode_name;
Lisp_Object BUFFER_INTERNAL_FIELD (mode_name);
/* Mode line element that controls format of mode line. */
Lisp_Object mode_line_format;
Lisp_Object BUFFER_INTERNAL_FIELD (mode_line_format);
/* Analogous to mode_line_format for the line displayed at the top
of windows. Nil means don't display that line. */
Lisp_Object header_line_format;
Lisp_Object BUFFER_INTERNAL_FIELD (header_line_format);
/* Keys that are bound local to this buffer. */
Lisp_Object keymap;
Lisp_Object BUFFER_INTERNAL_FIELD (keymap);
/* This buffer's local abbrev table. */
Lisp_Object abbrev_table;
Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_table);
/* This buffer's syntax table. */
Lisp_Object syntax_table;
Lisp_Object BUFFER_INTERNAL_FIELD (syntax_table);
/* This buffer's category table. */
Lisp_Object category_table;
Lisp_Object BUFFER_INTERNAL_FIELD (category_table);
/* Values of several buffer-local variables. */
/* tab-width is buffer-local so that redisplay can find it
in buffers that are not current. */
Lisp_Object case_fold_search;
Lisp_Object tab_width;
Lisp_Object fill_column;
Lisp_Object left_margin;
Lisp_Object BUFFER_INTERNAL_FIELD (case_fold_search);
Lisp_Object BUFFER_INTERNAL_FIELD (tab_width);
Lisp_Object BUFFER_INTERNAL_FIELD (fill_column);
Lisp_Object BUFFER_INTERNAL_FIELD (left_margin);
/* Function to call when insert space past fill column. */
Lisp_Object auto_fill_function;
Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function);
/* nil: text, t: binary.
This value is meaningful only on certain operating systems. */
/* Actually, we don't need this flag any more because end-of-line
is handled correctly according to the buffer-file-coding-system
of the buffer. Just keeping it for backward compatibility. */
Lisp_Object buffer_file_type;
Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_type);
/* Case table for case-conversion in this buffer.
This char-table maps each char into its lower-case version. */
Lisp_Object downcase_table;
Lisp_Object BUFFER_INTERNAL_FIELD (downcase_table);
/* Char-table mapping each char to its upper-case version. */
Lisp_Object upcase_table;
Lisp_Object BUFFER_INTERNAL_FIELD (upcase_table);
/* Char-table for conversion for case-folding search. */
Lisp_Object case_canon_table;
Lisp_Object BUFFER_INTERNAL_FIELD (case_canon_table);
/* Char-table of equivalences for case-folding search. */
Lisp_Object case_eqv_table;
Lisp_Object BUFFER_INTERNAL_FIELD (case_eqv_table);
/* Non-nil means do not display continuation lines. */
Lisp_Object truncate_lines;
Lisp_Object BUFFER_INTERNAL_FIELD (truncate_lines);
/* Non-nil means to use word wrapping when displaying continuation lines. */
Lisp_Object word_wrap;
Lisp_Object BUFFER_INTERNAL_FIELD (word_wrap);
/* Non-nil means display ctl chars with uparrow. */
Lisp_Object ctl_arrow;
Lisp_Object BUFFER_INTERNAL_FIELD (ctl_arrow);
/* Non-nil means reorder bidirectional text for display in the
visual order. */
Lisp_Object bidi_display_reordering;
Lisp_Object BUFFER_INTERNAL_FIELD (bidi_display_reordering);
/* If non-nil, specifies which direction of text to force in all the
paragraphs of the buffer. Nil means determine paragraph
direction dynamically for each paragraph. */
Lisp_Object bidi_paragraph_direction;
Lisp_Object BUFFER_INTERNAL_FIELD (bidi_paragraph_direction);
/* Non-nil means do selective display;
see doc string in syms_of_buffer (buffer.c) for details. */
Lisp_Object selective_display;
Lisp_Object BUFFER_INTERNAL_FIELD (selective_display);
#ifndef old
/* Non-nil means show ... at end of line followed by invisible lines. */
Lisp_Object selective_display_ellipses;
Lisp_Object BUFFER_INTERNAL_FIELD (selective_display_ellipses);
#endif
/* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
Lisp_Object minor_modes;
Lisp_Object BUFFER_INTERNAL_FIELD (minor_modes);
/* t if "self-insertion" should overwrite; `binary' if it should also
overwrite newlines and tabs - for editing executables and the like. */
Lisp_Object overwrite_mode;
Lisp_Object BUFFER_INTERNAL_FIELD (overwrite_mode);
/* non-nil means abbrev mode is on. Expand abbrevs automatically. */
Lisp_Object abbrev_mode;
Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_mode);
/* Display table to use for text in this buffer. */
Lisp_Object display_table;
Lisp_Object BUFFER_INTERNAL_FIELD (display_table);
/* t means the mark and region are currently active. */
Lisp_Object mark_active;
Lisp_Object BUFFER_INTERNAL_FIELD (mark_active);
/* Non-nil means the buffer contents are regarded as multi-byte
form of characters, not a binary code. */
Lisp_Object enable_multibyte_characters;
Lisp_Object BUFFER_INTERNAL_FIELD (enable_multibyte_characters);
/* Coding system to be used for encoding the buffer contents on
saving. */
Lisp_Object buffer_file_coding_system;
Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_coding_system);
/* List of symbols naming the file format used for visited file. */
Lisp_Object file_format;
Lisp_Object BUFFER_INTERNAL_FIELD (file_format);
/* List of symbols naming the file format used for auto-save file. */
Lisp_Object auto_save_file_format;
Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_format);
/* True if the newline position cache and width run cache are
enabled. See search.c and indent.c. */
Lisp_Object cache_long_line_scans;
Lisp_Object BUFFER_INTERNAL_FIELD (cache_long_line_scans);
/* If the width run cache is enabled, this table contains the
character widths width_run_cache (see above) assumes. When we
@ -726,99 +735,99 @@ struct buffer
current display table to see whether the display table has
affected the widths of any characters. If it has, we
invalidate the width run cache, and re-initialize width_table. */
Lisp_Object width_table;
Lisp_Object BUFFER_INTERNAL_FIELD (width_table);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
PT for this buffer when the buffer is not current. */
Lisp_Object pt_marker;
Lisp_Object BUFFER_INTERNAL_FIELD (pt_marker);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
BEGV for this buffer when the buffer is not current. */
Lisp_Object begv_marker;
Lisp_Object BUFFER_INTERNAL_FIELD (begv_marker);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
ZV for this buffer when the buffer is not current. */
Lisp_Object zv_marker;
Lisp_Object BUFFER_INTERNAL_FIELD (zv_marker);
/* This holds the point value before the last scroll operation.
Explicitly setting point sets this to nil. */
Lisp_Object point_before_scroll;
Lisp_Object BUFFER_INTERNAL_FIELD (point_before_scroll);
/* Truename of the visited file, or nil. */
Lisp_Object file_truename;
Lisp_Object BUFFER_INTERNAL_FIELD (file_truename);
/* Invisibility spec of this buffer.
t => any non-nil `invisible' property means invisible.
A list => `invisible' property means invisible
if it is memq in that list. */
Lisp_Object invisibility_spec;
Lisp_Object BUFFER_INTERNAL_FIELD (invisibility_spec);
/* This is the last window that was selected with this buffer in it,
or nil if that window no longer displays this buffer. */
Lisp_Object last_selected_window;
Lisp_Object BUFFER_INTERNAL_FIELD (last_selected_window);
/* Incremented each time the buffer is displayed in a window. */
Lisp_Object display_count;
Lisp_Object BUFFER_INTERNAL_FIELD (display_count);
/* Widths of left and right marginal areas for windows displaying
this buffer. */
Lisp_Object left_margin_cols, right_margin_cols;
Lisp_Object BUFFER_INTERNAL_FIELD (left_margin_cols), BUFFER_INTERNAL_FIELD (right_margin_cols);
/* Widths of left and right fringe areas for windows displaying
this buffer. */
Lisp_Object left_fringe_width, right_fringe_width;
Lisp_Object BUFFER_INTERNAL_FIELD (left_fringe_width), BUFFER_INTERNAL_FIELD (right_fringe_width);
/* Non-nil means fringes are drawn outside display margins;
othersize draw them between margin areas and text. */
Lisp_Object fringes_outside_margins;
Lisp_Object BUFFER_INTERNAL_FIELD (fringes_outside_margins);
/* Width and type of scroll bar areas for windows displaying
this buffer. */
Lisp_Object scroll_bar_width, vertical_scroll_bar_type;
Lisp_Object BUFFER_INTERNAL_FIELD (scroll_bar_width), BUFFER_INTERNAL_FIELD (vertical_scroll_bar_type);
/* Non-nil means indicate lines not displaying text (in a style
like vi). */
Lisp_Object indicate_empty_lines;
Lisp_Object BUFFER_INTERNAL_FIELD (indicate_empty_lines);
/* Non-nil means indicate buffer boundaries and scrolling. */
Lisp_Object indicate_buffer_boundaries;
Lisp_Object BUFFER_INTERNAL_FIELD (indicate_buffer_boundaries);
/* Logical to physical fringe bitmap mappings. */
Lisp_Object fringe_indicator_alist;
Lisp_Object BUFFER_INTERNAL_FIELD (fringe_indicator_alist);
/* Logical to physical cursor bitmap mappings. */
Lisp_Object fringe_cursor_alist;
Lisp_Object BUFFER_INTERNAL_FIELD (fringe_cursor_alist);
/* Time stamp updated each time this buffer is displayed in a window. */
Lisp_Object display_time;
Lisp_Object BUFFER_INTERNAL_FIELD (display_time);
/* If scrolling the display because point is below the bottom of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the top of the
window. Nil means that scrolling method isn't used. */
Lisp_Object scroll_up_aggressively;
Lisp_Object BUFFER_INTERNAL_FIELD (scroll_up_aggressively);
/* If scrolling the display because point is above the top of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the bottom of the
window. Nil means that scrolling method isn't used. */
Lisp_Object scroll_down_aggressively;
Lisp_Object BUFFER_INTERNAL_FIELD (scroll_down_aggressively);
/* Desired cursor type in this buffer. See the doc string of
per-buffer variable `cursor-type'. */
Lisp_Object cursor_type;
Lisp_Object BUFFER_INTERNAL_FIELD (cursor_type);
/* An integer > 0 means put that number of pixels below text lines
in the display of this buffer. */
Lisp_Object extra_line_spacing;
Lisp_Object BUFFER_INTERNAL_FIELD (extra_line_spacing);
/* *Cursor type to display in non-selected windows.
t means to use hollow box cursor.
See `cursor-type' for other values. */
Lisp_Object cursor_in_non_selected_windows;
Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows);
};
@ -942,7 +951,7 @@ extern int last_per_buffer_idx;
from the start of a buffer structure. */
#define PER_BUFFER_VAR_OFFSET(VAR) \
offsetof (struct buffer, VAR)
offsetof (struct buffer, BUFFER_INTERNAL_FIELD (VAR))
/* Return the index of buffer-local variable VAR. Each per-buffer
variable has an index > 0 associated with it, except when it always

2
src/bytecode.c
View file

@ -1398,7 +1398,7 @@ If the third argument is incorrect, Emacs may crash. */)
CHECK_CHARACTER (TOP);
AFTER_POTENTIAL_GC ();
c = XFASTINT (TOP);
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
MAKE_CHAR_MULTIBYTE (c);
XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
}

16
src/callint.c
View file

@ -149,12 +149,12 @@ static void
check_mark (int for_region)
{
Lisp_Object tem;
tem = Fmarker_buffer (current_buffer->mark);
tem = Fmarker_buffer (B_ (current_buffer, mark));
if (NILP (tem) || (XBUFFER (tem) != current_buffer))
error (for_region ? "The mark is not set now, so there is no region"
: "The mark is not set now");
if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
&& NILP (current_buffer->mark_active))
&& NILP (B_ (current_buffer, mark_active)))
xsignal0 (Qmark_inactive);
}
@ -385,7 +385,7 @@ invoke it. If KEYS is omitted or nil, the return value of
else if (*string == '*')
{
string++;
if (!NILP (current_buffer->read_only))
if (!NILP (B_ (current_buffer, read_only)))
{
if (!NILP (record_flag))
{
@ -543,7 +543,7 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'D': /* Directory name. */
args[i] = Fread_file_name (callint_message, Qnil,
current_buffer->directory, Qlambda, Qnil,
B_ (current_buffer, directory), Qlambda, Qnil,
Qfile_directory_p);
break;
@ -661,7 +661,7 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'm': /* Value of mark. Does not do I/O. */
check_mark (0);
/* visargs[i] = Qnil; */
args[i] = current_buffer->mark;
args[i] = B_ (current_buffer, mark);
varies[i] = 2;
break;
@ -717,11 +717,11 @@ invoke it. If KEYS is omitted or nil, the return value of
check_mark (1);
set_marker_both (point_marker, Qnil, PT, PT_BYTE);
/* visargs[i+1] = Qnil; */
foo = marker_position (current_buffer->mark);
foo = marker_position (B_ (current_buffer, mark));
/* visargs[i] = Qnil; */
args[i] = PT < foo ? point_marker : current_buffer->mark;
args[i] = PT < foo ? point_marker : B_ (current_buffer, mark);
varies[i] = 3;
args[++i] = PT > foo ? point_marker : current_buffer->mark;
args[++i] = PT > foo ? point_marker : B_ (current_buffer, mark);
varies[i] = 4;
break;

16
src/callproc.c
View file

@ -265,7 +265,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
if (nargs >= 2 && ! NILP (args[1]))
{
infile = Fexpand_file_name (args[1], current_buffer->directory);
infile = Fexpand_file_name (args[1], B_ (current_buffer, directory));
CHECK_STRING (infile);
}
else
@ -322,7 +322,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
current_dir = current_buffer->directory;
current_dir = B_ (current_buffer, directory);
GCPRO4 (infile, buffer, current_dir, error_file);
@ -336,7 +336,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
Fcons (current_buffer->directory, Qnil));
Fcons (B_ (current_buffer, directory), Qnil));
if (STRING_MULTIBYTE (infile))
infile = ENCODE_FILE (infile);
@ -559,9 +559,9 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
setpgrp (pid, pid);
#endif /* USG */
/* GTK causes us to ignore SIGPIPE, make sure it is restored
/* GConf causes us to ignore SIGPIPE, make sure it is restored
in the child. */
signal (SIGPIPE, SIG_DFL);
//signal (SIGPIPE, SIG_DFL);
#ifdef HAVE_WORKING_VFORK
sigprocmask (SIG_SETMASK, &procmask, 0);
#endif
@ -663,7 +663,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
/* In unibyte mode, character code conversion should not take
place but EOL conversion should. So, setup raw-text or one
of the subsidiary according to the information just setup. */
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
&& !NILP (val))
val = raw_text_coding_system (val);
setup_coding_system (val, &process_coding);
@ -713,7 +713,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
if (!NILP (buffer))
{
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
&& ! CODING_MAY_REQUIRE_DECODING (&process_coding))
insert_1_both (buf, nread, nread, 0, 1, 0);
else
@ -926,7 +926,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
/* Decide coding-system of the contents of the temporary file. */
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (current_buffer->enable_multibyte_characters))
else if (NILP (B_ (current_buffer, enable_multibyte_characters)))
val = Qraw_text;
else
{

12
src/casefiddle.c
View file

@ -39,15 +39,15 @@ casify_object (enum case_action flag, Lisp_Object obj)
register int inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
Fset_case_table (current_buffer->downcase_table);
if (NILP (XCHAR_TABLE (B_ (current_buffer, downcase_table))->extras[1]))
Fset_case_table (B_ (current_buffer, downcase_table));
if (INTEGERP (obj))
{
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
@ -198,7 +198,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
{
register int c;
register int inword = flag == CASE_DOWN;
register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
register int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters));
EMACS_INT start, end;
EMACS_INT start_byte, end_byte;
EMACS_INT first = -1, last; /* Position of first and last changes. */
@ -210,8 +210,8 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
return;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1]))
Fset_case_table (current_buffer->downcase_table);
if (NILP (XCHAR_TABLE (B_ (current_buffer, downcase_table))->extras[1]))
Fset_case_table (B_ (current_buffer, downcase_table));
validate_region (&b, &e);
start = XFASTINT (b);

10
src/casetab.c
View file

@ -71,7 +71,7 @@ DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0,
doc: /* Return the case table of the current buffer. */)
(void)
{
return current_buffer->downcase_table;
return B_ (current_buffer, downcase_table);
}
DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0,
@ -160,10 +160,10 @@ set_case_table (Lisp_Object table, int standard)
}
else
{
current_buffer->downcase_table = table;
current_buffer->upcase_table = up;
current_buffer->case_canon_table = canon;
current_buffer->case_eqv_table = eqv;
B_ (current_buffer, downcase_table) = table;
B_ (current_buffer, upcase_table) = up;
B_ (current_buffer, case_canon_table) = canon;
B_ (current_buffer, case_eqv_table) = eqv;
}
return table;

8
src/category.c
View file

@ -190,7 +190,7 @@ Lisp_Object
check_category_table (Lisp_Object table)
{
if (NILP (table))
return current_buffer->category_table;
return B_ (current_buffer, category_table);
CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table);
return table;
}
@ -200,7 +200,7 @@ DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
This is the one specified by the current buffer. */)
(void)
{
return current_buffer->category_table;
return B_ (current_buffer, category_table);
}
DEFUN ("standard-category-table", Fstandard_category_table,
@ -281,7 +281,7 @@ Return TABLE. */)
{
int idx;
table = check_category_table (table);
current_buffer->category_table = table;
B_ (current_buffer, category_table) = table;
/* Indicate that this buffer now has a specified category table. */
idx = PER_BUFFER_VAR_IDX (category_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
@ -292,7 +292,7 @@ Return TABLE. */)
Lisp_Object
char_category_set (int c)
{
return CHAR_TABLE_REF (current_buffer->category_table, c);
return CHAR_TABLE_REF (B_ (current_buffer, category_table), c);
}
DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,

2
src/category.h
View file

@ -91,7 +91,7 @@ extern Lisp_Object _temp_category_set;
/* The standard category table is stored where it will automatically
be used in all new buffers. */
#define Vstandard_category_table buffer_defaults.category_table
#define Vstandard_category_table B_ (&buffer_defaults, category_table)
/* Return the category set of character C in the current category table. */
#define CATEGORY_SET(c) char_category_set (c)

4
src/character.c
View file

@ -521,7 +521,7 @@ chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
{
/* current_buffer is null at early stages of Emacs initialization. */
if (current_buffer == 0
|| NILP (current_buffer->enable_multibyte_characters))
|| NILP (B_ (current_buffer, enable_multibyte_characters)))
return nbytes;
return multibyte_chars_in_text (ptr, nbytes);
@ -987,7 +987,7 @@ character is not ASCII nor 8-bit character, an error is signalled. */)
pos = XFASTINT (position);
p = CHAR_POS_ADDR (pos);
}
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
return make_number (*p);
}
else

12
src/character.h
View file

@ -417,7 +417,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
do \
{ \
CHARIDX++; \
if (!NILP (current_buffer->enable_multibyte_characters)) \
if (!NILP (B_ (current_buffer, enable_multibyte_characters))) \
{ \
unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \
int len; \
@ -484,7 +484,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
do \
{ \
(charpos)++; \
if (NILP (current_buffer->enable_multibyte_characters)) \
if (NILP (B_ (current_buffer, enable_multibyte_characters))) \
(bytepos)++; \
else \
INC_POS ((bytepos)); \
@ -498,7 +498,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
do \
{ \
(charpos)--; \
if (NILP (current_buffer->enable_multibyte_characters)) \
if (NILP (B_ (current_buffer, enable_multibyte_characters))) \
(bytepos)--; \
else \
DEC_POS ((bytepos)); \
@ -561,11 +561,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define ASCII_CHAR_WIDTH(c) \
(c < 0x20 \
? (c == '\t' \
? XFASTINT (current_buffer->tab_width) \
: (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
? XFASTINT (B_ (current_buffer, tab_width)) \
: (c == '\n' ? 0 : (NILP (B_ (current_buffer, ctl_arrow)) ? 4 : 2))) \
: (c < 0x7f \
? 1 \
: ((NILP (current_buffer->ctl_arrow) ? 4 : 2))))
: ((NILP (B_ (current_buffer, ctl_arrow)) ? 4 : 2))))
/* Return the width of character C. The width is measured by how many
columns C will occupy on the screen when displayed in the current

2
src/charset.c
View file

@ -1554,7 +1554,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
EMACS_INT from, from_byte, to, stop, stop_byte;
int i;
Lisp_Object val;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters));
validate_region (&beg, &end);
from = XFASTINT (beg);

22
src/cmds.c
View file

@ -292,10 +292,10 @@ After insertion, the value of `auto-fill-function' is called if the
}
if (remove_boundary
&& CONSP (current_buffer->undo_list)
&& NILP (XCAR (current_buffer->undo_list)))
&& CONSP (B_ (current_buffer, undo_list))
&& NILP (XCAR (B_ (current_buffer, undo_list))))
/* Remove the undo_boundary that was just pushed. */
current_buffer->undo_list = XCDR (current_buffer->undo_list);
B_ (current_buffer, undo_list) = XCDR (B_ (current_buffer, undo_list));
/* Barf if the key that invoked this was not a character. */
if (!CHARACTERP (last_command_event))
@ -335,12 +335,12 @@ internal_self_insert (int c, EMACS_INT n)
EMACS_INT chars_to_delete = 0;
EMACS_INT spaces_to_insert = 0;
overwrite = current_buffer->overwrite_mode;
overwrite = B_ (current_buffer, overwrite_mode);
if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
hairy = 1;
/* At first, get multi-byte form of C in STR. */
if (!NILP (current_buffer->enable_multibyte_characters))
if (!NILP (B_ (current_buffer, enable_multibyte_characters)))
{
len = CHAR_STRING (c, str);
if (len == 1)
@ -416,11 +416,11 @@ internal_self_insert (int c, EMACS_INT n)
synt = SYNTAX (c);
if (!NILP (current_buffer->abbrev_mode)
if (!NILP (B_ (current_buffer, abbrev_mode))
&& synt != Sword
&& NILP (current_buffer->read_only)
&& NILP (B_ (current_buffer, read_only))
&& PT > BEGV
&& (SYNTAX (!NILP (current_buffer->enable_multibyte_characters)
&& (SYNTAX (!NILP (B_ (current_buffer, enable_multibyte_characters))
? XFASTINT (Fprevious_char ())
: UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
== Sword))
@ -448,7 +448,7 @@ internal_self_insert (int c, EMACS_INT n)
if (chars_to_delete)
{
int mc = ((NILP (current_buffer->enable_multibyte_characters)
int mc = ((NILP (B_ (current_buffer, enable_multibyte_characters))
&& SINGLE_BYTE_CHAR_P (c))
? UNIBYTE_TO_CHAR (c) : c);
Lisp_Object string = Fmake_string (make_number (n), make_number (mc));
@ -479,7 +479,7 @@ internal_self_insert (int c, EMACS_INT n)
if ((CHAR_TABLE_P (Vauto_fill_chars)
? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c))
: (c == ' ' || c == '\n'))
&& !NILP (current_buffer->auto_fill_function))
&& !NILP (B_ (current_buffer, auto_fill_function)))
{
Lisp_Object tem;
@ -488,7 +488,7 @@ internal_self_insert (int c, EMACS_INT n)
that. Must have the newline in place already so filling and
justification, if any, know where the end is going to be. */
SET_PT_BOTH (PT - 1, PT_BYTE - 1);
tem = call0 (current_buffer->auto_fill_function);
tem = call0 (B_ (current_buffer, auto_fill_function));
/* Test PT < ZV in case the auto-fill-function is strange. */
if (c == '\n' && PT < ZV)
SET_PT_BOTH (PT + 1, PT_BYTE + 1);

36
src/coding.c
View file

@ -7038,8 +7038,8 @@ decode_coding (struct coding_system *coding)
set_buffer_internal (XBUFFER (coding->dst_object));
if (GPT != PT)
move_gap_both (PT, PT_BYTE);
undo_list = current_buffer->undo_list;
current_buffer->undo_list = Qt;
undo_list = B_ (current_buffer, undo_list);
B_ (current_buffer, undo_list) = Qt;
}
coding->consumed = coding->consumed_char = 0;
@ -7136,7 +7136,7 @@ decode_coding (struct coding_system *coding)
decode_eol (coding);
if (BUFFERP (coding->dst_object))
{
current_buffer->undo_list = undo_list;
B_ (current_buffer, undo_list) = undo_list;
record_insert (coding->dst_pos, coding->produced_char);
}
return coding->result;
@ -7433,7 +7433,7 @@ encode_coding (struct coding_system *coding)
{
set_buffer_internal (XBUFFER (coding->dst_object));
coding->dst_multibyte
= ! NILP (current_buffer->enable_multibyte_characters);
= ! NILP (B_ (current_buffer, enable_multibyte_characters));
}
coding->consumed = coding->consumed_char = 0;
@ -7504,8 +7504,8 @@ make_conversion_work_buffer (int multibyte)
doesn't compile new regexps. */
Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt);
Ferase_buffer ();
current_buffer->undo_list = Qt;
current_buffer->enable_multibyte_characters = multibyte ? Qt : Qnil;
B_ (current_buffer, undo_list) = Qt;
B_ (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil;
set_buffer_internal (current);
return workbuf;
}
@ -7562,7 +7562,7 @@ decode_coding_gap (struct coding_system *coding,
coding->dst_object = coding->src_object;
coding->dst_pos = PT;
coding->dst_pos_byte = PT_BYTE;
coding->dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
coding->dst_multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters));
if (CODING_REQUIRE_DETECTION (coding))
detect_coding (coding);
@ -7728,7 +7728,7 @@ decode_coding_object (struct coding_system *coding,
coding->dst_pos = BUF_PT (XBUFFER (dst_object));
coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
coding->dst_multibyte
= ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
= ! NILP (B_ (XBUFFER (dst_object), enable_multibyte_characters));
}
else
{
@ -7798,7 +7798,7 @@ decode_coding_object (struct coding_system *coding,
TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
else if (saved_pt < from + chars)
TEMP_SET_PT_BOTH (from, from_byte);
else if (! NILP (current_buffer->enable_multibyte_characters))
else if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
saved_pt_byte + (coding->produced - bytes));
else
@ -7822,7 +7822,7 @@ decode_coding_object (struct coding_system *coding,
{
tail->bytepos = from_byte + coding->produced;
tail->charpos
= (NILP (current_buffer->enable_multibyte_characters)
= (NILP (B_ (current_buffer, enable_multibyte_characters))
? tail->bytepos : from + coding->produced_char);
}
}
@ -7960,7 +7960,7 @@ encode_coding_object (struct coding_system *coding,
set_buffer_temp (current);
}
coding->dst_multibyte
= ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
= ! NILP (B_ (XBUFFER (dst_object), enable_multibyte_characters));
}
else if (EQ (dst_object, Qt))
{
@ -8003,7 +8003,7 @@ encode_coding_object (struct coding_system *coding,
TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
else if (saved_pt < from + chars)
TEMP_SET_PT_BOTH (from, from_byte);
else if (! NILP (current_buffer->enable_multibyte_characters))
else if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
saved_pt_byte + (coding->produced - bytes));
else
@ -8027,7 +8027,7 @@ encode_coding_object (struct coding_system *coding,
{
tail->bytepos = from_byte + coding->produced;
tail->charpos
= (NILP (current_buffer->enable_multibyte_characters)
= (NILP (B_ (current_buffer, enable_multibyte_characters))
? tail->bytepos : from + coding->produced_char);
}
}
@ -8481,8 +8481,8 @@ highest priority. */)
return detect_coding_system (BYTE_POS_ADDR (from_byte),
to - from, to_byte - from_byte,
!NILP (highest),
!NILP (current_buffer
->enable_multibyte_characters),
!NILP (B_ (current_buffer
, enable_multibyte_characters)),
Qnil);
}
@ -8564,7 +8564,7 @@ DEFUN ("find-coding-systems-region-internal",
CHECK_NUMBER_COERCE_MARKER (end);
if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
args_out_of_range (start, end);
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
return Qt;
start_byte = CHAR_TO_BYTE (XINT (start));
end_byte = CHAR_TO_BYTE (XINT (end));
@ -8698,7 +8698,7 @@ to the string. */)
validate_region (&start, &end);
from = XINT (start);
to = XINT (end);
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
|| (ascii_compatible
&& (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from)))))
return Qnil;
@ -8814,7 +8814,7 @@ is nil. */)
CHECK_NUMBER_COERCE_MARKER (end);
if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
args_out_of_range (start, end);
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
return Qnil;
start_byte = CHAR_TO_BYTE (XINT (start));
end_byte = CHAR_TO_BYTE (XINT (end));

8
src/composite.c
View file

@ -796,7 +796,7 @@ fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end, Lis
if (NILP (string))
{
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
error ("Attempt to shape unibyte text");
validate_region (&start, &end);
from = XFASTINT (start);
@ -1028,7 +1028,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos,
cmp_it->stop_pos = endpos = start;
cmp_it->ch = -1;
}
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
|| NILP (Vauto_composition_mode))
return;
if (bytepos < 0)
@ -1674,7 +1674,7 @@ composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt)
return new_pt;
}
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
|| NILP (Vauto_composition_mode))
return new_pt;
@ -1851,7 +1851,7 @@ See `find-composition' for more details. */)
if (!find_composition (from, to, &start, &end, &prop, string))
{
if (!NILP (current_buffer->enable_multibyte_characters)
if (!NILP (B_ (current_buffer, enable_multibyte_characters))
&& ! NILP (Vauto_composition_mode)
&& find_automatic_composition (from, to, &start, &end, &gstring,
string))

24
src/data.c
View file

@ -1009,7 +1009,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
}
else
{
tem1 = assq_no_quit (var, current_buffer->local_var_alist);
tem1 = assq_no_quit (var, B_ (current_buffer, local_var_alist));
XSETBUFFER (blv->where, current_buffer);
}
}
@ -1178,7 +1178,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
tem1 = Fassq (symbol,
(blv->frame_local
? XFRAME (where)->param_alist
: XBUFFER (where)->local_var_alist));
: B_ (XBUFFER (where), local_var_alist)));
blv->where = where;
blv->found = 1;
@ -1209,8 +1209,8 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
bindings, not for frame-local bindings. */
eassert (!blv->frame_local);
tem1 = Fcons (symbol, XCDR (blv->defcell));
XBUFFER (where)->local_var_alist
= Fcons (tem1, XBUFFER (where)->local_var_alist);
B_ (XBUFFER (where), local_var_alist)
= Fcons (tem1, B_ (XBUFFER (where), local_var_alist));
}
}
@ -1632,13 +1632,13 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
if (let_shadows_global_binding_p (symbol))
message ("Making %s local to %s while let-bound!",
SDATA (SYMBOL_NAME (variable)),
SDATA (current_buffer->name));
SDATA (B_ (current_buffer, name)));
}
}
/* Make sure this buffer has its own value of symbol. */
XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
tem = Fassq (variable, current_buffer->local_var_alist);
tem = Fassq (variable, B_ (current_buffer, local_var_alist));
if (NILP (tem))
{
if (let_shadows_buffer_binding_p (sym))
@ -1650,9 +1650,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
default value. */
find_symbol_value (variable);
current_buffer->local_var_alist
B_ (current_buffer, local_var_alist)
= Fcons (Fcons (variable, XCDR (blv->defcell)),
current_buffer->local_var_alist);
B_ (current_buffer, local_var_alist));
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value. */
@ -1718,10 +1718,10 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
/* Get rid of this buffer's alist element, if any. */
XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
tem = Fassq (variable, current_buffer->local_var_alist);
tem = Fassq (variable, B_ (current_buffer, local_var_alist));
if (!NILP (tem))
current_buffer->local_var_alist
= Fdelq (tem, current_buffer->local_var_alist);
B_ (current_buffer, local_var_alist)
= Fdelq (tem, B_ (current_buffer, local_var_alist));
/* If the symbol is set up with the current buffer's binding
loaded, recompute its value. We have to do it now, or else
@ -1848,7 +1848,7 @@ BUFFER defaults to the current buffer. */)
XSETBUFFER (tmp, buf);
XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
if (EQ (variable, XCAR (elt)))

2
src/dired.c
View file

@ -158,7 +158,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m
# ifdef WINDOWSNT
/* Windows users want case-insensitive wildcards. */
bufp = compile_pattern (match, 0,
buffer_defaults.case_canon_table, 0, 1);
B_ (&buffer_defaults, case_canon_table), 0, 1);
# else /* !WINDOWSNT */
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif /* !WINDOWSNT */

6
src/dispextern.h
View file

@ -1416,7 +1416,7 @@ struct glyph_string
&& !(W)->pseudo_window_p \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
&& BUFFERP ((W)->buffer) \
&& !NILP (XBUFFER ((W)->buffer)->mode_line_format) \
&& !NILP (B_ (XBUFFER ((W)->buffer), mode_line_format)) \
&& WINDOW_TOTAL_LINES (W) > 1)
/* Value is non-zero if window W wants a header line. */
@ -1426,8 +1426,8 @@ struct glyph_string
&& !(W)->pseudo_window_p \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
&& BUFFERP ((W)->buffer) \
&& !NILP (XBUFFER ((W)->buffer)->header_line_format) \
&& WINDOW_TOTAL_LINES (W) > 1 + !NILP (XBUFFER ((W)->buffer)->mode_line_format))
&& !NILP (B_ (XBUFFER ((W)->buffer), header_line_format)) \
&& WINDOW_TOTAL_LINES (W) > 1 + !NILP (B_ (XBUFFER ((W)->buffer), mode_line_format)))
/* Return proper value to be used as baseline offset of font that has

8
src/dispnew.c
View file

@ -6129,7 +6129,7 @@ pass nil for VARIABLE. */)
{
buf = XCDR (XCAR (tail));
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (XBUFFER (buf)->name, 0) == ' ')
if (SREF (B_ (XBUFFER (buf), name), 0) == ' ')
continue;
if (vecp == end)
goto changed;
@ -6137,7 +6137,7 @@ pass nil for VARIABLE. */)
goto changed;
if (vecp == end)
goto changed;
if (!EQ (*vecp++, XBUFFER (buf)->read_only))
if (!EQ (*vecp++, B_ (XBUFFER (buf), read_only)))
goto changed;
if (vecp == end)
goto changed;
@ -6184,10 +6184,10 @@ pass nil for VARIABLE. */)
{
buf = XCDR (XCAR (tail));
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (XBUFFER (buf)->name, 0) == ' ')
if (SREF (B_ (XBUFFER (buf), name), 0) == ' ')
continue;
*vecp++ = buf;
*vecp++ = XBUFFER (buf)->read_only;
*vecp++ = B_ (XBUFFER (buf), read_only);
*vecp++ = Fbuffer_modified_p (buf);
}
/* Fill up the vector with lambdas (always at least one). */

74
src/editfns.c
View file

@ -306,10 +306,10 @@ region_limit (int beginningp)
if (!NILP (Vtransient_mark_mode)
&& NILP (Vmark_even_if_inactive)
&& NILP (current_buffer->mark_active))
&& NILP (B_ (current_buffer, mark_active)))
xsignal0 (Qmark_inactive);
m = Fmarker_position (current_buffer->mark);
m = Fmarker_position (B_ (current_buffer, mark));
if (NILP (m))
error ("The mark is not set now, so there is no region");
@ -338,7 +338,7 @@ Watch out! Moving this marker changes the mark position.
If you set the marker not to point anywhere, the buffer will have no mark. */)
(void)
{
return current_buffer->mark;
return B_ (current_buffer, mark);
}
@ -866,9 +866,9 @@ save_excursion_save (void)
== current_buffer);
return Fcons (Fpoint_marker (),
Fcons (Fcopy_marker (current_buffer->mark, Qnil),
Fcons (Fcopy_marker (B_ (current_buffer, mark), Qnil),
Fcons (visible ? Qt : Qnil,
Fcons (current_buffer->mark_active,
Fcons (B_ (current_buffer, mark_active),
selected_window))));
}
@ -900,8 +900,8 @@ save_excursion_restore (Lisp_Object info)
/* Mark marker. */
info = XCDR (info);
tem = XCAR (info);
omark = Fmarker_position (current_buffer->mark);
Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
omark = Fmarker_position (B_ (current_buffer, mark));
Fset_marker (B_ (current_buffer, mark), tem, Fcurrent_buffer ());
nmark = Fmarker_position (tem);
unchain_marker (XMARKER (tem));
@ -922,14 +922,14 @@ save_excursion_restore (Lisp_Object info)
/* Mark active */
info = XCDR (info);
tem = XCAR (info);
tem1 = current_buffer->mark_active;
current_buffer->mark_active = tem;
tem1 = B_ (current_buffer, mark_active);
B_ (current_buffer, mark_active) = tem;
if (!NILP (Vrun_hooks))
{
/* If mark is active now, and either was not active
or was at a different place, run the activate hook. */
if (! NILP (current_buffer->mark_active))
if (! NILP (B_ (current_buffer, mark_active)))
{
if (! EQ (omark, nmark))
call1 (Vrun_hooks, intern ("activate-mark-hook"));
@ -1114,7 +1114,7 @@ At the beginning of the buffer or accessible region, return 0. */)
Lisp_Object temp;
if (PT <= BEGV)
XSETFASTINT (temp, 0);
else if (!NILP (current_buffer->enable_multibyte_characters))
else if (!NILP (B_ (current_buffer, enable_multibyte_characters)))
{
EMACS_INT pos = PT_BYTE;
DEC_POS (pos);
@ -1228,7 +1228,7 @@ If POS is out of range, the value is nil. */)
pos_byte = CHAR_TO_BYTE (XINT (pos));
}
if (!NILP (current_buffer->enable_multibyte_characters))
if (!NILP (B_ (current_buffer, enable_multibyte_characters)))
{
DEC_POS (pos_byte);
XSETFASTINT (val, FETCH_CHAR (pos_byte));
@ -2135,7 +2135,7 @@ general_insert_function (void (*insert_func)
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len;
if (!NILP (current_buffer->enable_multibyte_characters))
if (!NILP (B_ (current_buffer, enable_multibyte_characters)))
len = CHAR_STRING (XFASTINT (val), str);
else
{
@ -2267,7 +2267,7 @@ from adjoining text, if those properties are sticky. */)
CHECK_NUMBER (character);
CHECK_NUMBER (count);
if (!NILP (current_buffer->enable_multibyte_characters))
if (!NILP (B_ (current_buffer, enable_multibyte_characters)))
len = CHAR_STRING (XFASTINT (character), str);
else
str[0] = XFASTINT (character), len = 1;
@ -2316,7 +2316,7 @@ from adjoining text, if those properties are sticky. */)
if (XINT (byte) < 0 || XINT (byte) > 255)
args_out_of_range_3 (byte, make_number (0), make_number (255));
if (XINT (byte) >= 128
&& ! NILP (current_buffer->enable_multibyte_characters))
&& ! NILP (B_ (current_buffer, enable_multibyte_characters)))
XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte)));
return Finsert_char (byte, count, inherit);
}
@ -2370,7 +2370,7 @@ make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte,
if (start < GPT && GPT < end)
move_gap (start);
if (! NILP (current_buffer->enable_multibyte_characters))
if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
result = make_uninit_multibyte_string (end - start, end_byte - start_byte);
else
result = make_uninit_string (end - start);
@ -2485,7 +2485,7 @@ They default to the values of (point-min) and (point-max) in BUFFER. */)
if (NILP (buf))
nsberror (buffer);
bp = XBUFFER (buf);
if (NILP (bp->name))
if (NILP (B_ (bp, name)))
error ("Selecting deleted buffer");
if (NILP (start))
@ -2533,8 +2533,8 @@ determines whether case is significant or ignored. */)
register EMACS_INT begp1, endp1, begp2, endp2, temp;
register struct buffer *bp1, *bp2;
register Lisp_Object trt
= (!NILP (current_buffer->case_fold_search)
? current_buffer->case_canon_table : Qnil);
= (!NILP (B_ (current_buffer, case_fold_search))
? B_ (current_buffer, case_canon_table) : Qnil);
EMACS_INT chars = 0;
EMACS_INT i1, i2, i1_byte, i2_byte;
@ -2549,7 +2549,7 @@ determines whether case is significant or ignored. */)
if (NILP (buf1))
nsberror (buffer1);
bp1 = XBUFFER (buf1);
if (NILP (bp1->name))
if (NILP (B_ (bp1, name)))
error ("Selecting deleted buffer");
}
@ -2587,7 +2587,7 @@ determines whether case is significant or ignored. */)
if (NILP (buf2))
nsberror (buffer2);
bp2 = XBUFFER (buf2);
if (NILP (bp2->name))
if (NILP (B_ (bp2, name)))
error ("Selecting deleted buffer");
}
@ -2627,7 +2627,7 @@ determines whether case is significant or ignored. */)
QUIT;
if (! NILP (bp1->enable_multibyte_characters))
if (! NILP (B_ (bp1, enable_multibyte_characters)))
{
c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
BUF_INC_POS (bp1, i1_byte);
@ -2640,7 +2640,7 @@ determines whether case is significant or ignored. */)
i1++;
}
if (! NILP (bp2->enable_multibyte_characters))
if (! NILP (B_ (bp2, enable_multibyte_characters)))
{
c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte);
BUF_INC_POS (bp2, i2_byte);
@ -2680,13 +2680,13 @@ determines whether case is significant or ignored. */)
static Lisp_Object
subst_char_in_region_unwind (Lisp_Object arg)
{
return current_buffer->undo_list = arg;
return B_ (current_buffer, undo_list) = arg;
}
static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
return current_buffer->filename = arg;
return B_ (current_buffer, filename) = arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
@ -2712,7 +2712,7 @@ Both characters must have the same length of multi-byte form. */)
#define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
int maybe_byte_combining = COMBINING_NO;
EMACS_INT last_changed = 0;
int multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
int multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters));
restart:
@ -2756,12 +2756,12 @@ Both characters must have the same length of multi-byte form. */)
if (!changed && !NILP (noundo))
{
record_unwind_protect (subst_char_in_region_unwind,
current_buffer->undo_list);
current_buffer->undo_list = Qt;
B_ (current_buffer, undo_list));
B_ (current_buffer, undo_list) = Qt;
/* Don't do file-locking. */
record_unwind_protect (subst_char_in_region_unwind_1,
current_buffer->filename);
current_buffer->filename = Qnil;
B_ (current_buffer, filename));
B_ (current_buffer, filename) = Qnil;
}
if (pos_byte < GPT_BYTE)
@ -2824,7 +2824,7 @@ Both characters must have the same length of multi-byte form. */)
struct gcpro gcpro1;
tem = current_buffer->undo_list;
tem = B_ (current_buffer, undo_list);
GCPRO1 (tem);
/* Make a multibyte string containing this single character. */
@ -2843,7 +2843,7 @@ Both characters must have the same length of multi-byte form. */)
INC_POS (pos_byte_next);
if (! NILP (noundo))
current_buffer->undo_list = tem;
B_ (current_buffer, undo_list) = tem;
UNGCPRO;
}
@ -2945,7 +2945,7 @@ It returns the number of characters changed. */)
int cnt; /* Number of changes made. */
EMACS_INT size; /* Size of translate table. */
EMACS_INT pos, pos_byte, end_pos;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters));
int string_multibyte;
Lisp_Object val;
@ -3206,7 +3206,7 @@ save_restriction_restore (Lisp_Object data)
? XMARKER (XCAR (data))->buffer
: XBUFFER (data));
if (buf && buf != current_buffer && !NILP (buf->pt_marker))
if (buf && buf != current_buffer && !NILP (B_ (buf, pt_marker)))
{ /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
is the case if it is or has an indirect buffer), then make
sure it is current before we update BEGV, so
@ -4136,20 +4136,20 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer. */)
if (XINT (c1) == XINT (c2))
return Qt;
if (NILP (current_buffer->case_fold_search))
if (NILP (B_ (current_buffer, case_fold_search)))
return Qnil;
/* Do these in separate statements,
then compare the variables.
because of the way DOWNCASE uses temp variables. */
i1 = XFASTINT (c1);
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
&& ! ASCII_CHAR_P (i1))
{
MAKE_CHAR_MULTIBYTE (i1);
}
i2 = XFASTINT (c2);
if (NILP (current_buffer->enable_multibyte_characters)
if (NILP (B_ (current_buffer, enable_multibyte_characters))
&& ! ASCII_CHAR_P (i2))
{
MAKE_CHAR_MULTIBYTE (i2);

178
src/fileio.c
View file

@ -770,7 +770,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
default_directory = current_buffer->directory;
default_directory = B_ (current_buffer, directory);
if (! STRINGP (default_directory))
{
#ifdef DOS_NT
@ -2669,7 +2669,7 @@ See `file-symlink-p' to distinguish symlinks. */)
struct stat st;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, current_buffer->directory);
absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -2722,7 +2722,7 @@ See `file-symlink-p' to distinguish symlinks. */)
struct stat st;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, current_buffer->directory);
absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -2769,7 +2769,7 @@ if file does not exist, is not accessible, or SELinux is disabled */)
context_t context;
#endif
absname = expand_and_dir_to_file (filename, current_buffer->directory);
absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -2827,7 +2827,7 @@ is disabled. */)
context_t parsed_con;
#endif
absname = Fexpand_file_name (filename, current_buffer->directory);
absname = Fexpand_file_name (filename, B_ (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -2894,7 +2894,7 @@ Return nil, if file does not exist or is not accessible. */)
struct stat st;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, current_buffer->directory);
absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -2923,7 +2923,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
absname = Fexpand_file_name (filename, current_buffer->directory);
absname = Fexpand_file_name (filename, B_ (current_buffer, directory));
CHECK_NUMBER (mode);
/* If the file name has special constructs in it,
@ -2985,7 +2985,7 @@ Use the current time if TIME is nil. TIME is in the format of
if (! lisp_time_argument (time, &sec, &usec))
error ("Invalid time specification");
absname = Fexpand_file_name (filename, current_buffer->directory);
absname = Fexpand_file_name (filename, B_ (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -3047,8 +3047,8 @@ otherwise, if FILE2 does not exist, the answer is t. */)
absname1 = Qnil;
GCPRO2 (absname1, file2);
absname1 = expand_and_dir_to_file (file1, current_buffer->directory);
absname2 = expand_and_dir_to_file (file2, current_buffer->directory);
absname1 = expand_and_dir_to_file (file1, B_ (current_buffer, directory));
absname2 = expand_and_dir_to_file (file2, B_ (current_buffer, directory));
UNGCPRO;
/* If the file name has special constructs in it,
@ -3116,8 +3116,8 @@ decide_coding_unwind (Lisp_Object unwind_data)
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
/* Now we are safe to change the buffer's multibyteness directly. */
current_buffer->enable_multibyte_characters = multibyte;
current_buffer->undo_list = undo_list;
B_ (current_buffer, enable_multibyte_characters) = multibyte;
B_ (current_buffer, undo_list) = undo_list;
return Qnil;
}
@ -3212,7 +3212,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
if (!NILP (current_buffer->read_only))
if (!NILP (B_ (current_buffer, read_only)))
Fbarf_if_buffer_read_only ();
val = Qnil;
@ -3403,16 +3403,16 @@ variable `last-coding-system-used' to the coding system actually used. */)
buf = XBUFFER (buffer);
delete_all_overlays (buf);
buf->directory = current_buffer->directory;
buf->read_only = Qnil;
buf->filename = Qnil;
buf->undo_list = Qt;
B_ (buf, directory) = B_ (current_buffer, directory);
B_ (buf, read_only) = Qnil;
B_ (buf, filename) = Qnil;
B_ (buf, undo_list) = Qt;
eassert (buf->overlays_before == NULL);
eassert (buf->overlays_after == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
buf->enable_multibyte_characters = Qnil;
B_ (buf, enable_multibyte_characters) = Qnil;
insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
@ -3450,7 +3450,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
else
CHECK_CODING_SYSTEM (coding_system);
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
/* We must suppress all character code conversion except for
end-of-line conversion. */
coding_system = raw_text_coding_system (coding_system);
@ -3598,7 +3598,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
we cannot use this method; giveup and try the other. */
if (same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) >= 0200
&& ! NILP (current_buffer->enable_multibyte_characters)
&& ! NILP (B_ (current_buffer, enable_multibyte_characters))
&& (CODING_MAY_REQUIRE_DECODING (&coding)))
giveup_match_end = 1;
break;
@ -3617,14 +3617,14 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Extend the start of non-matching text area to multibyte
character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
same_at_start--;
/* Extend the end of non-matching text area to multibyte
character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
same_at_end++;
@ -3673,7 +3673,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
unsigned char *decoded;
EMACS_INT temp;
int this_count = SPECPDL_INDEX ();
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters));
Lisp_Object conversion_buffer;
conversion_buffer = code_conversion_save (1, multibyte);
@ -3778,7 +3778,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Extend the start of non-matching text area to the previous
multibyte character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
same_at_start--;
@ -3795,7 +3795,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
/* Extend the end of non-matching text area to the next
multibyte character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
same_at_end++;
@ -3870,9 +3870,9 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (NILP (visit) && inserted > 0)
{
#ifdef CLASH_DETECTION
if (!NILP (current_buffer->file_truename)
if (!NILP (B_ (current_buffer, file_truename))
/* Make binding buffer-file-name to nil effective. */
&& !NILP (current_buffer->filename)
&& !NILP (B_ (current_buffer, filename))
&& SAVE_MODIFF >= MODIFF)
we_locked_file = 1;
#endif /* CLASH_DETECTION */
@ -3977,7 +3977,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
{
#ifdef CLASH_DETECTION
if (we_locked_file)
unlock_file (current_buffer->file_truename);
unlock_file (B_ (current_buffer, file_truename));
#endif
Vdeactivate_mark = old_Vdeactivate_mark;
}
@ -4028,11 +4028,11 @@ variable `last-coding-system-used' to the coding system actually used. */)
Lisp_Object unwind_data;
int count = SPECPDL_INDEX ();
unwind_data = Fcons (current_buffer->enable_multibyte_characters,
Fcons (current_buffer->undo_list,
unwind_data = Fcons (B_ (current_buffer, enable_multibyte_characters),
Fcons (B_ (current_buffer, undo_list),
Fcurrent_buffer ()));
current_buffer->enable_multibyte_characters = Qnil;
current_buffer->undo_list = Qt;
B_ (current_buffer, enable_multibyte_characters) = Qnil;
B_ (current_buffer, undo_list) = Qt;
record_unwind_protect (decide_coding_unwind, unwind_data);
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
@ -4062,7 +4062,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
else
CHECK_CODING_SYSTEM (coding_system);
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
/* We must suppress all character code conversion except for
end-of-line conversion. */
coding_system = raw_text_coding_system (coding_system);
@ -4080,10 +4080,10 @@ variable `last-coding-system-used' to the coding system actually used. */)
&& NILP (replace))
/* Visiting a file with these coding system makes the buffer
unibyte. */
current_buffer->enable_multibyte_characters = Qnil;
B_ (current_buffer, enable_multibyte_characters) = Qnil;
}
coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
coding.dst_multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters));
if (CODING_MAY_REQUIRE_DECODING (&coding)
&& (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
{
@ -4110,9 +4110,9 @@ variable `last-coding-system-used' to the coding system actually used. */)
if ((VECTORP (CODING_ID_EOL_TYPE (coding.id))
|| EQ (CODING_ID_EOL_TYPE (coding.id), Qunix))
&& ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
B_ (current_buffer, buffer_file_type) = Qt;
else
current_buffer->buffer_file_type = Qnil;
B_ (current_buffer, buffer_file_type) = Qnil;
#endif
handled:
@ -4124,24 +4124,24 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (!NILP (visit))
{
if (!EQ (current_buffer->undo_list, Qt) && !nochange)
current_buffer->undo_list = Qnil;
if (!EQ (B_ (current_buffer, undo_list), Qt) && !nochange)
B_ (current_buffer, undo_list) = Qnil;
if (NILP (handler))
{
current_buffer->modtime = st.st_mtime;
current_buffer->modtime_size = st.st_size;
current_buffer->filename = orig_filename;
B_ (current_buffer, filename) = orig_filename;
}
SAVE_MODIFF = MODIFF;
BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
XSETFASTINT (B_ (current_buffer, save_length), Z - BEG);
#ifdef CLASH_DETECTION
if (NILP (handler))
{
if (!NILP (current_buffer->file_truename))
unlock_file (current_buffer->file_truename);
if (!NILP (B_ (current_buffer, file_truename)))
unlock_file (B_ (current_buffer, file_truename));
unlock_file (filename);
}
#endif /* CLASH_DETECTION */
@ -4174,8 +4174,8 @@ variable `last-coding-system-used' to the coding system actually used. */)
specbind (Qinhibit_modification_hooks, Qt);
/* Save old undo list and don't record undo for decoding. */
old_undo = current_buffer->undo_list;
current_buffer->undo_list = Qt;
old_undo = B_ (current_buffer, undo_list);
B_ (current_buffer, undo_list) = Qt;
if (NILP (replace))
{
@ -4263,7 +4263,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
if (NILP (visit))
{
current_buffer->undo_list = old_undo;
B_ (current_buffer, undo_list) = old_undo;
if (CONSP (old_undo) && inserted != old_inserted)
{
/* Adjust the last undo record for the size change during
@ -4278,7 +4278,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
else
/* If undo_list was Qt before, keep it that way.
Otherwise start with an empty undo_list. */
current_buffer->undo_list = EQ (old_undo, Qt) ? Qt : Qnil;
B_ (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil;
unbind_to (count, Qnil);
}
@ -4332,8 +4332,8 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
Lisp_Object eol_parent = Qnil;
if (auto_saving
&& NILP (Fstring_equal (current_buffer->filename,
current_buffer->auto_save_file_name)))
&& NILP (Fstring_equal (B_ (current_buffer, filename),
B_ (current_buffer, auto_save_file_name))))
{
val = Qutf_8_emacs;
eol_parent = Qunix;
@ -4362,12 +4362,12 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
int using_default_coding = 0;
int force_raw_text = 0;
val = current_buffer->buffer_file_coding_system;
val = B_ (current_buffer, buffer_file_coding_system);
if (NILP (val)
|| NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
{
val = Qnil;
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
force_raw_text = 1;
}
@ -4388,7 +4388,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
{
/* If we still have not decided a coding system, use the
default value of buffer-file-coding-system. */
val = current_buffer->buffer_file_coding_system;
val = B_ (current_buffer, buffer_file_coding_system);
using_default_coding = 1;
}
@ -4412,9 +4412,9 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
format, we use that of
`default-buffer-file-coding-system'. */
if (! using_default_coding
&& ! NILP (buffer_defaults.buffer_file_coding_system))
&& ! NILP (B_ (&buffer_defaults, buffer_file_coding_system)))
val = (coding_inherit_eol_type
(val, buffer_defaults.buffer_file_coding_system));
(val, B_ (&buffer_defaults, buffer_file_coding_system)));
/* If we decide not to encode text, use `raw-text' or one of its
subsidiaries. */
@ -4425,7 +4425,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
val = coding_inherit_eol_type (val, eol_parent);
setup_coding_system (val, coding);
if (!STRINGP (start) && !NILP (current_buffer->selective_display))
if (!STRINGP (start) && !NILP (B_ (current_buffer, selective_display)))
coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
return val;
}
@ -4529,8 +4529,8 @@ This calls `write-region-annotate-functions' at the start, and
if (visiting)
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
XSETFASTINT (B_ (current_buffer, save_length), Z - BEG);
B_ (current_buffer, filename) = visit_file;
}
UNGCPRO;
return val;
@ -4743,15 +4743,15 @@ This calls `write-region-annotate-functions' at the start, and
if (visiting)
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
XSETFASTINT (B_ (current_buffer, save_length), Z - BEG);
B_ (current_buffer, filename) = visit_file;
update_mode_lines++;
}
else if (quietly)
{
if (auto_saving
&& ! NILP (Fstring_equal (current_buffer->filename,
current_buffer->auto_save_file_name)))
&& ! NILP (Fstring_equal (B_ (current_buffer, filename),
B_ (current_buffer, auto_save_file_name))))
SAVE_MODIFF = MODIFF;
return Qnil;
@ -4833,10 +4833,10 @@ build_annotations (Lisp_Object start, Lisp_Object end)
}
/* Now do the same for annotation functions implied by the file-format */
if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
p = current_buffer->auto_save_file_format;
if (auto_saving && (!EQ (B_ (current_buffer, auto_save_file_format), Qt)))
p = B_ (current_buffer, auto_save_file_format);
else
p = current_buffer->file_format;
p = B_ (current_buffer, file_format);
for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
@ -5015,17 +5015,17 @@ See Info node `(elisp)Modification Time' for more details. */)
b = XBUFFER (buf);
}
if (!STRINGP (b->filename)) return Qt;
if (!STRINGP (B_ (b, filename))) return Qt;
if (b->modtime == 0) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (b->filename,
handler = Ffind_file_name_handler (B_ (b, filename),
Qverify_visited_file_modtime);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
filename = ENCODE_FILE (b->filename);
filename = ENCODE_FILE (B_ (b, filename));
if (stat (SSDATA (filename), &st) < 0)
{
@ -5093,7 +5093,7 @@ An argument specifies the modification time value to use
struct stat st;
Lisp_Object handler;
filename = Fexpand_file_name (current_buffer->filename, Qnil);
filename = Fexpand_file_name (B_ (current_buffer, filename), Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -5128,7 +5128,7 @@ auto_save_error (Lisp_Object error)
ring_bell (XFRAME (selected_frame));
args[0] = build_string ("Auto-saving %s: %s");
args[1] = current_buffer->name;
args[1] = B_ (current_buffer, name);
args[2] = Ferror_message_string (error);
msg = Fformat (3, args);
GCPRO1 (msg);
@ -5159,19 +5159,19 @@ auto_save_1 (void)
auto_save_mode_bits = 0666;
/* Get visited file's mode to become the auto save file's mode. */
if (! NILP (current_buffer->filename))
if (! NILP (B_ (current_buffer, filename)))
{
if (stat (SSDATA (current_buffer->filename), &st) >= 0)
if (stat (SSDATA (B_ (current_buffer, filename)), &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = st.st_mode | 0600;
else if ((modes = Ffile_modes (current_buffer->filename),
else if ((modes = Ffile_modes (B_ (current_buffer, filename)),
INTEGERP (modes)))
/* Remote files don't cooperate with stat. */
auto_save_mode_bits = XINT (modes) | 0600;
}
return
Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil,
Fwrite_region (Qnil, Qnil, B_ (current_buffer, auto_save_file_name), Qnil,
NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
Qnil, Qnil);
}
@ -5312,18 +5312,18 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
/* Record all the buffers that have auto save mode
in the special file that lists them. For each of these buffers,
Record visited name (if any) and auto save name. */
if (STRINGP (b->auto_save_file_name)
if (STRINGP (B_ (b, auto_save_file_name))
&& stream != NULL && do_handled_files == 0)
{
BLOCK_INPUT;
if (!NILP (b->filename))
if (!NILP (B_ (b, filename)))
{
fwrite (SDATA (b->filename), 1,
SBYTES (b->filename), stream);
fwrite (SDATA (B_ (b, filename)), 1,
SBYTES (B_ (b, filename)), stream);
}
putc ('\n', stream);
fwrite (SDATA (b->auto_save_file_name), 1,
SBYTES (b->auto_save_file_name), stream);
fwrite (SDATA (B_ (b, auto_save_file_name)), 1,
SBYTES (B_ (b, auto_save_file_name)), stream);
putc ('\n', stream);
UNBLOCK_INPUT;
}
@ -5340,13 +5340,13 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
/* Check for auto save enabled
and file changed since last auto save
and file changed since last real save. */
if (STRINGP (b->auto_save_file_name)
if (STRINGP (B_ (b, auto_save_file_name))
&& BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
&& BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
/* -1 means we've turned off autosaving for a while--see below. */
&& XINT (b->save_length) >= 0
&& XINT (B_ (b, save_length)) >= 0
&& (do_handled_files
|| NILP (Ffind_file_name_handler (b->auto_save_file_name,
|| NILP (Ffind_file_name_handler (B_ (b, auto_save_file_name),
Qwrite_region))))
{
EMACS_TIME before_time, after_time;
@ -5360,23 +5360,23 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
set_buffer_internal (b);
if (NILP (Vauto_save_include_big_deletions)
&& (XFASTINT (b->save_length) * 10
&& (XFASTINT (B_ (b, save_length)) * 10
> (BUF_Z (b) - BUF_BEG (b)) * 13)
/* A short file is likely to change a large fraction;
spare the user annoying messages. */
&& XFASTINT (b->save_length) > 5000
&& XFASTINT (B_ (b, save_length)) > 5000
/* These messages are frequent and annoying for `*mail*'. */
&& !EQ (b->filename, Qnil)
&& !EQ (B_ (b, filename), Qnil)
&& NILP (no_message))
{
/* It has shrunk too much; turn off auto-saving here. */
minibuffer_auto_raise = orig_minibuffer_auto_raise;
message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
b->name, 1);
B_ (b, name), 1);
minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
XSETINT (b->save_length, -1);
XSETINT (B_ (b, save_length), -1);
Fsleep_for (make_number (1), Qnil);
continue;
}
@ -5385,7 +5385,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
internal_condition_case (auto_save_1, Qt, auto_save_error);
auto_saved++;
BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
XSETFASTINT (current_buffer->save_length, Z - BEG);
XSETFASTINT (B_ (current_buffer, save_length), Z - BEG);
set_buffer_internal (old);
EMACS_GET_TIME (after_time);
@ -5432,7 +5432,7 @@ No auto-save file will be written until the buffer changes again. */)
/* FIXME: This should not be called in indirect buffers, since
they're not autosaved. */
BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
XSETFASTINT (B_ (current_buffer, save_length), Z - BEG);
current_buffer->auto_save_failure_time = -1;
return Qnil;
}

14
src/filelock.c
View file

@ -637,9 +637,9 @@ unlock_all_files (void)
for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
b = XBUFFER (XCDR (XCAR (tail)));
if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
if (STRINGP (B_ (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
{
unlock_file(b->file_truename);
unlock_file(B_ (b, file_truename));
}
}
}
@ -652,7 +652,7 @@ or else nothing is done if current buffer isn't visiting a file. */)
(Lisp_Object file)
{
if (NILP (file))
file = current_buffer->file_truename;
file = B_ (current_buffer, file_truename);
else
CHECK_STRING (file);
if (SAVE_MODIFF < MODIFF
@ -669,8 +669,8 @@ should not be locked in that case. */)
(void)
{
if (SAVE_MODIFF < MODIFF
&& STRINGP (current_buffer->file_truename))
unlock_file (current_buffer->file_truename);
&& STRINGP (B_ (current_buffer, file_truename)))
unlock_file (B_ (current_buffer, file_truename));
return Qnil;
}
@ -680,8 +680,8 @@ void
unlock_buffer (struct buffer *buffer)
{
if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
&& STRINGP (buffer->file_truename))
unlock_file (buffer->file_truename);
&& STRINGP (B_ (buffer, file_truename)))
unlock_file (B_ (buffer, file_truename));
}
DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,

12
src/fns.c
View file

@ -2984,7 +2984,7 @@ into shorter lines. */)
SAFE_ALLOCA (encoded, char *, allength);
encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg),
encoded, length, NILP (no_line_break),
!NILP (current_buffer->enable_multibyte_characters));
!NILP (B_ (current_buffer, enable_multibyte_characters)));
if (encoded_length > allength)
abort ();
@ -3166,7 +3166,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
EMACS_INT old_pos = PT;
EMACS_INT decoded_length;
EMACS_INT inserted_chars;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters));
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
@ -4684,12 +4684,12 @@ guesswork fails. Normally, an error is signaled in such case. */)
{
int force_raw_text = 0;
coding_system = XBUFFER (object)->buffer_file_coding_system;
coding_system = B_ (XBUFFER (object), buffer_file_coding_system);
if (NILP (coding_system)
|| NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
{
coding_system = Qnil;
if (NILP (current_buffer->enable_multibyte_characters))
if (NILP (B_ (current_buffer, enable_multibyte_characters)))
force_raw_text = 1;
}
@ -4706,11 +4706,11 @@ guesswork fails. Normally, an error is signaled in such case. */)
}
if (NILP (coding_system)
&& !NILP (XBUFFER (object)->buffer_file_coding_system))
&& !NILP (B_ (XBUFFER (object), buffer_file_coding_system)))
{
/* If we still have not decided a coding system, use the
default value of buffer-file-coding-system. */
coding_system = XBUFFER (object)->buffer_file_coding_system;
coding_system = B_ (XBUFFER (object), buffer_file_coding_system);
}
if (!force_raw_text

2
src/font.c
View file

@ -3637,7 +3637,7 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
Lisp_Object font_object;
multibyte = (NILP (string)
? ! NILP (current_buffer->enable_multibyte_characters)
? ! NILP (B_ (current_buffer, enable_multibyte_characters))
: STRING_MULTIBYTE (string));
if (c < 0)
{

2
src/frame.c
View file

@ -1817,7 +1817,7 @@ make_frame_visible_1 (Lisp_Object window)
w = XWINDOW (window);
if (!NILP (w->buffer))
XBUFFER (w->buffer)->display_time = Fcurrent_time ();
B_ (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
if (!NILP (w->vchild))
make_frame_visible_1 (w->vchild);

18
src/fringe.c
View file

@ -660,7 +660,7 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor)
{
Lisp_Object cmap, bm = Qnil;
if ((cmap = XBUFFER (w->buffer)->fringe_cursor_alist), !NILP (cmap))
if ((cmap = B_ (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap))
{
bm = Fassq (cursor, cmap);
if (CONSP (bm))
@ -670,9 +670,9 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor)
return lookup_fringe_bitmap (bm);
}
}
if (EQ (cmap, buffer_defaults.fringe_cursor_alist))
if (EQ (cmap, B_ (&buffer_defaults, fringe_cursor_alist)))
return NO_FRINGE_BITMAP;
bm = Fassq (cursor, buffer_defaults.fringe_cursor_alist);
bm = Fassq (cursor, B_ (&buffer_defaults, fringe_cursor_alist));
if (!CONSP (bm) || ((bm = XCDR (bm)), NILP (bm)))
return NO_FRINGE_BITMAP;
return lookup_fringe_bitmap (bm);
@ -697,7 +697,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in
If partial, lookup partial bitmap in default value if not found here.
If not partial, or no partial spec is present, use non-partial bitmap. */
if ((cmap = XBUFFER (w->buffer)->fringe_indicator_alist), !NILP (cmap))
if ((cmap = B_ (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap))
{
bm1 = Fassq (bitmap, cmap);
if (CONSP (bm1))
@ -731,10 +731,10 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in
}
}
if (!EQ (cmap, buffer_defaults.fringe_indicator_alist)
&& !NILP (buffer_defaults.fringe_indicator_alist))
if (!EQ (cmap, B_ (&buffer_defaults, fringe_indicator_alist))
&& !NILP (B_ (&buffer_defaults, fringe_indicator_alist)))
{
bm2 = Fassq (bitmap, buffer_defaults.fringe_indicator_alist);
bm2 = Fassq (bitmap, B_ (&buffer_defaults, fringe_indicator_alist));
if (CONSP (bm2))
{
if ((bm2 = XCDR (bm2)), !NILP (bm2))
@ -919,7 +919,7 @@ update_window_fringes (struct window *w, int keep_current_p)
return 0;
if (!MINI_WINDOW_P (w)
&& (ind = XBUFFER (w->buffer)->indicate_buffer_boundaries, !NILP (ind)))
&& (ind = B_ (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind)))
{
if (EQ (ind, Qleft) || EQ (ind, Qright))
boundary_top = boundary_bot = arrow_top = arrow_bot = ind;
@ -988,7 +988,7 @@ update_window_fringes (struct window *w, int keep_current_p)
}
}
empty_pos = XBUFFER (w->buffer)->indicate_empty_lines;
empty_pos = B_ (XBUFFER (w->buffer), indicate_empty_lines);
if (!NILP (empty_pos) && !EQ (empty_pos, Qright))
empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft;

2
src/gtkutil.c
View file

@ -3677,7 +3677,7 @@ xg_tool_bar_menu_proxy (GtkToolItem *toolitem, gpointer user_data)
GtkLabel *wlbl = GTK_LABEL (xg_get_tool_bar_widgets (vb, &c1));
GtkImage *wimage = GTK_IMAGE (c1);
GtkWidget *wmenuitem = gtk_image_menu_item_new_with_label
(gtk_label_get_text (wlbl));
(wlbl ? gtk_label_get_text (wlbl) : "");
GtkWidget *wmenuimage;

62
src/indent.c
View file

@ -70,7 +70,7 @@ buffer_display_table (void)
{
Lisp_Object thisbuf;
thisbuf = current_buffer->display_table;
thisbuf = B_ (current_buffer, display_table);
if (DISP_TABLE_P (thisbuf))
return XCHAR_TABLE (thisbuf);
if (DISP_TABLE_P (Vstandard_display_table))
@ -140,9 +140,9 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
int i;
struct Lisp_Vector *widthtab;
if (!VECTORP (buf->width_table))
buf->width_table = Fmake_vector (make_number (256), make_number (0));
widthtab = XVECTOR (buf->width_table);
if (!VECTORP (B_ (buf, width_table)))
B_ (buf, width_table) = Fmake_vector (make_number (256), make_number (0));
widthtab = XVECTOR (B_ (buf, width_table));
if (widthtab->size != 256)
abort ();
@ -156,17 +156,17 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
static void
width_run_cache_on_off (void)
{
if (NILP (current_buffer->cache_long_line_scans)
if (NILP (B_ (current_buffer, cache_long_line_scans))
/* And, for the moment, this feature doesn't work on multibyte
characters. */
|| !NILP (current_buffer->enable_multibyte_characters))
|| !NILP (B_ (current_buffer, enable_multibyte_characters)))
{
/* It should be off. */
if (current_buffer->width_run_cache)
{
free_region_cache (current_buffer->width_run_cache);
current_buffer->width_run_cache = 0;
current_buffer->width_table = Qnil;
B_ (current_buffer, width_table) = Qnil;
}
}
else
@ -329,8 +329,8 @@ current_column (void)
register int tab_seen;
int post_tab;
register int c;
register int tab_width = XINT (current_buffer->tab_width);
int ctl_arrow = !NILP (current_buffer->ctl_arrow);
register int tab_width = XINT (B_ (current_buffer, tab_width));
int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow));
register struct Lisp_Char_Table *dp = buffer_display_table ();
if (PT == last_known_column_point
@ -417,7 +417,7 @@ current_column (void)
col++;
else if (c == '\n'
|| (c == '\r'
&& EQ (current_buffer->selective_display, Qt)))
&& EQ (B_ (current_buffer, selective_display), Qt)))
{
ptr++;
goto start_of_line_found;
@ -512,10 +512,10 @@ check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
static void
scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
{
register EMACS_INT tab_width = XINT (current_buffer->tab_width);
register int ctl_arrow = !NILP (current_buffer->ctl_arrow);
register EMACS_INT tab_width = XINT (B_ (current_buffer, tab_width));
register int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow));
register struct Lisp_Char_Table *dp = buffer_display_table ();
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters));
struct composition_it cmp_it;
Lisp_Object window;
struct window *w;
@ -637,7 +637,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
if (c == '\n')
goto endloop;
if (c == '\r' && EQ (current_buffer->selective_display, Qt))
if (c == '\r' && EQ (B_ (current_buffer, selective_display), Qt))
goto endloop;
if (c == '\t')
{
@ -655,7 +655,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
if (c == '\n')
goto endloop;
if (c == '\r' && EQ (current_buffer->selective_display, Qt))
if (c == '\r' && EQ (B_ (current_buffer, selective_display), Qt))
goto endloop;
if (c == '\t')
{
@ -809,7 +809,7 @@ The return value is COLUMN. */)
{
int mincol;
register int fromcol;
register int tab_width = XINT (current_buffer->tab_width);
register int tab_width = XINT (B_ (current_buffer, tab_width));
CHECK_NUMBER (column);
if (NILP (minimum))
@ -872,7 +872,7 @@ static double
position_indentation (register int pos_byte)
{
register EMACS_INT column = 0;
register EMACS_INT tab_width = XINT (current_buffer->tab_width);
register EMACS_INT tab_width = XINT (B_ (current_buffer, tab_width));
register unsigned char *p;
register unsigned char *stop;
unsigned char *start;
@ -924,7 +924,7 @@ position_indentation (register int pos_byte)
switch (*p++)
{
case 0240:
if (! NILP (current_buffer->enable_multibyte_characters))
if (! NILP (B_ (current_buffer, enable_multibyte_characters)))
return column;
case ' ':
column++;
@ -934,7 +934,7 @@ position_indentation (register int pos_byte)
break;
default:
if (ASCII_BYTE_P (p[-1])
|| NILP (current_buffer->enable_multibyte_characters))
|| NILP (B_ (current_buffer, enable_multibyte_characters)))
return column;
{
int c;
@ -1123,13 +1123,13 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
register EMACS_INT pos;
EMACS_INT pos_byte;
register int c = 0;
register EMACS_INT tab_width = XFASTINT (current_buffer->tab_width);
register int ctl_arrow = !NILP (current_buffer->ctl_arrow);
register EMACS_INT tab_width = XFASTINT (B_ (current_buffer, tab_width));
register int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow));
register struct Lisp_Char_Table *dp = window_display_table (win);
int selective
= (INTEGERP (current_buffer->selective_display)
? XINT (current_buffer->selective_display)
: !NILP (current_buffer->selective_display) ? -1 : 0);
= (INTEGERP (B_ (current_buffer, selective_display))
? XINT (B_ (current_buffer, selective_display))
: !NILP (B_ (current_buffer, selective_display)) ? -1 : 0);
int selective_rlen
= (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp))
? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0);
@ -1151,7 +1151,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
EMACS_INT next_width_run = from;
Lisp_Object window;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters));
/* If previous char scanned was a wide character,
this is the column where it ended. Otherwise, this is 0. */
EMACS_INT wide_column_end_hpos = 0;
@ -1170,8 +1170,8 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
width_run_cache_on_off ();
if (dp == buffer_display_table ())
width_table = (VECTORP (current_buffer->width_table)
? XVECTOR (current_buffer->width_table)->contents
width_table = (VECTORP (B_ (current_buffer, width_table))
? XVECTOR (B_ (current_buffer, width_table))->contents
: 0);
else
/* If the window has its own display table, we can't use the width
@ -1337,7 +1337,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_
}
if (hscroll || truncate
|| !NILP (current_buffer->truncate_lines))
|| !NILP (B_ (current_buffer, truncate_lines)))
{
/* Truncating: skip to newline, unless we are already past
TO (we need to go back below). */
@ -1838,9 +1838,9 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
EMACS_INT from_byte;
EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0;
int selective
= (INTEGERP (current_buffer->selective_display)
? XINT (current_buffer->selective_display)
: !NILP (current_buffer->selective_display) ? -1 : 0);
= (INTEGERP (B_ (current_buffer, selective_display))
? XINT (B_ (current_buffer, selective_display))
: !NILP (B_ (current_buffer, selective_display)) ? -1 : 0);
Lisp_Object window;
EMACS_INT start_hpos = 0;
int did_motion;

Some files were not shown because too many files have changed in this diff Show more