diff options
| author | Paul Eggert <eggert@cs.ucla.edu> | 2011-02-14 21:41:07 -0800 |
|---|---|---|
| committer | Paul Eggert <eggert@cs.ucla.edu> | 2011-02-14 21:41:07 -0800 |
| commit | fae95934b8edae3f538063e756ac799ed94313b2 (patch) | |
| tree | 3bb814c43cd50db54591bf685e5cb72b863b5833 | |
| parent | 6d302144c218f12bd380344ae2d3ed87a6ea9327 (diff) | |
| parent | bb55f713d2e4ea089a861a257d7d000432642ce9 (diff) | |
| download | emacs-fae95934b8edae3f538063e756ac799ed94313b2.tar.gz | |
Merge from mainline.
131 files changed, 3636 insertions, 3435 deletions
diff --git a/ChangeLog b/ChangeLog index 85165338460..52db9f45cd6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -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. diff --git a/admin/ChangeLog b/admin/ChangeLog index ce7ff76aa2c..335fe1df921 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -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. diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index 061af80b6cf..77e64a862c8 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -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)) diff --git a/admin/notes/bzr b/admin/notes/bzr index cb2a1bd4e4f..11f0af17a3b 100644 --- a/admin/notes/bzr +++ b/admin/notes/bzr @@ -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. diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index d04c0322862..ec57887a154 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -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 diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 1482bbd0469..41a09a5f713 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -428,29 +428,20 @@ 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}: +To specify a font, use fontconfig font names as values to the @code{font} +resource, or old style names: @example -Emacs.pane.menubar.faceName: none -Emacs.pane.dialog.faceName: none +Emacs.pane.menubar.font: lucidasanstypewriter-10 @end example @noindent -To specify a non-Xft font, use @code{font}. For example: - -@example -Emacs.pane.menubar.font: lucidasanstypewriter-10 -@end example +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 @@ -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 diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 61e05aaf332..20463724c79 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -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. diff --git a/doc/misc/ada-mode.texi b/doc/misc/ada-mode.texi index 80949aefb33..4be88b40361 100644 --- a/doc/misc/ada-mode.texi +++ b/doc/misc/ada-mode.texi @@ -39,6 +39,7 @@ developing GNU and promoting software freedom.'' @contents @node Top, Overview, (dir), (dir) +@top Ada Mode @ifnottex @insertcopying diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index bad37dbe85a..2541dba9873 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -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 @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 @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) -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. +@example +password @var{mypassword} +@end example -The login and password are simply your login credentials to the server. +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}). + +If that fails, the unencrypted netrc file @code{~/.authinfo} will +be used. -The simplest working netrc line example is one without a port. +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 diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 21f91c9125e..9ae569c151c 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -69,6 +69,7 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top +@top Dired Extra @comment node-name, next, previous, up @noindent diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi index 66a5e38443d..81a1ab0d29d 100644 --- a/doc/misc/ebrowse.texi +++ b/doc/misc/ebrowse.texi @@ -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. diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 2a55541bbfd..743a3460f9b 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -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 - diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index b0652ab3f10..e21abcdb137 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -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 diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index be518db6463..98da23768ec 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -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. diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 880cfb988a3..8c1ab92032f 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -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. diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi index 621d78b962f..fbeadb6a522 100644 --- a/doc/misc/sc.texi +++ b/doc/misc/sc.texi @@ -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 diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi index 980839cdec9..280438195b5 100644 --- a/doc/misc/speedbar.texi +++ b/doc/misc/speedbar.texi @@ -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 diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 1fe8a1872f6..4467c1e860f 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -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 @@ end \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 @@ end \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,59 +2531,14 @@ end \fi\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}} - -% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), -% `example' (@kbd uses ttsl only inside of @example and friends), -% or `code' (@kbd uses normal tty font always). -\parseargdef\kbdinputstyle{% - \def\txiarg{#1}% - \ifx\txiarg\worddistinct - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% - \else\ifx\txiarg\wordexample - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% - \else\ifx\txiarg\wordcode - \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% - \else - \errhelp = \EMsimple - \errmessage{Unknown @kbdinputstyle option `\txiarg'}% - \fi\fi\fi -} -\def\worddistinct{distinct} -\def\wordexample{example} -\def\wordcode{code} - -% Default is `distinct'. -\kbdinputstyle distinct - -\def\xkey{\key} -\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% -\ifx\one\xkey\ifx\threex\three \key{#2}% -\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi -\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi} - -% For @indicateurl, @env, @command quotes seem unnecessary, so use \code. -\let\indicateurl=\code -\let\env=\code -\let\command=\code - -% @clicksequence{File @click{} Open ...} -\def\clicksequence#1{\begingroup #1\endgroup} - -% @clickstyle @arrow (by default) -\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 +% 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}% @@ -2636,7 +2559,11 @@ end \endlink \endgroup} -\def\nouref#1,#2,#3,#4\finish{\begingroup % doesn't work in @example +% 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}% @@ -2648,18 +2575,87 @@ end \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 + \unhbox0\ (\urefcode{#1})% DVI: 2nd arg given, show both it and url \fi \else - \urefcode{\scantokens{#1\empty}}% only url given, so show it + \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 @@ -2681,6 +2677,51 @@ end \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}} + +% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), +% `example' (@kbd uses ttsl only inside of @example and friends), +% or `code' (@kbd uses normal tty font always). +\parseargdef\kbdinputstyle{% + \def\txiarg{#1}% + \ifx\txiarg\worddistinct + \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% + \else\ifx\txiarg\wordexample + \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% + \else\ifx\txiarg\wordcode + \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% + \else + \errhelp = \EMsimple + \errmessage{Unknown @kbdinputstyle setting `\txiarg'}% + \fi\fi\fi +} +\def\worddistinct{distinct} +\def\wordexample{example} +\def\wordcode{code} + +% Default is `distinct'. +\kbdinputstyle distinct + +\def\xkey{\key} +\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% +\ifx\one\xkey\ifx\threex\three \key{#2}% +\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi +\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi} + +% For @indicateurl, @env, @command quotes seem unnecessary, so use \code. +\let\indicateurl=\code +\let\env=\code +\let\command=\code + +% @clicksequence{File @click{} Open ...} +\def\clicksequence#1{\begingroup #1\endgroup} + +% @clickstyle @arrow (by default) +\parseargdef\clickstyle{\def\click{#1}} +\def\click{\arrow} + % 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 @@ end % \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 @@ directory should work if nowhere else does.} \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 @@ directory should work if nowhere else does.} % 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 @@ directory should work if nowhere else does.} % 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 diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6095d83d484..994a8f99676 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -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 diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index c3e767bd228..2968642bcc2 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -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 diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 5bfa96ec673..d337c82494c 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -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. diff --git a/etc/ChangeLog b/etc/ChangeLog index 45dfb211bb0..520a12ba15f 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -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> @@ -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 diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el new file mode 100644 index 00000000000..60f9fa8dc9d --- /dev/null +++ b/etc/themes/light-blue-theme.el @@ -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 diff --git a/lib-src/.gitignore b/lib-src/.gitignore index e1693b13c5e..c931a15d7b6 100644 --- a/lib-src/.gitignore +++ b/lib-src/.gitignore @@ -1,6 +1,5 @@ DOC ctags.c -getopt.h stamp_BLD echolisp.tmp diff --git a/lib/gettext.h b/lib/gettext.h index eb74aecb9a8..458e3322177 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -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. diff --git a/lib/ignore-value.h b/lib/ignore-value.h index 5e683bbb533..f021a1ac8ea 100644 --- a/lib/ignore-value.h +++ b/lib/ignore-value.h @@ -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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7cd39ae6d4b..742cbfc9267 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 2f92578b516..d99622944a3 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -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 \ diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6f33831eb38..cb1324051a7 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -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) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index e0caae059b4..8011b4d32a4 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -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..." diff --git a/lisp/dired.el b/lisp/dired.el index 3a76398e956..058dbdc548a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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" "\ diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 2d3b228cbd4..9880e2918b0 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -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)) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index e10dc10447c..8e192a18459 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -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. diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index fcd21b73de7..1c578556835 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -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 diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 3bdd9565fb5..267317594b1 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -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). diff --git a/lisp/faces.el b/lisp/faces.el index 2a0badab370..11c4108644a 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -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)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 8781ab3c0ec..747f71f835a 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -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 diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 381ae544b24..4882032f284 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -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. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index e94cfb137b0..be698ad35d0 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -39,23 +39,64 @@ ;;; Code: +(require 'password-cache) (require 'gnus-util) (require 'netrc) - +(require 'assoc) (eval-when-compile (require 'cl)) +(require 'eieio) + (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") (autoload 'secrets-get-alias "secrets") -(autoload 'secrets-get-attribute "secrets") +(autoload 'secrets-get-attributes "secrets") (autoload 'secrets-get-secret "secrets") (autoload 'secrets-list-collections "secrets") (autoload 'secrets-search-items "secrets") +(defvar secrets-enabled) + (defgroup auth-source nil "Authentication sources." :version "23.1" ;; No Gnus :group 'gnus) +(defclass auth-source-backend () + ((type :initarg :type + :initform 'netrc + :type symbol + :custom symbol + :documentation "The backend type.") + (source :initarg :source + :type string + :custom string + :documentation "The backend source.") + (host :initarg :host + :initform t + :type t + :custom string + :documentation "The backend host.") + (user :initarg :user + :initform t + :type t + :custom string + :documentation "The backend user.") + (protocol :initarg :protocol + :initform t + :type t + :custom string + :documentation "The backend protocol.") + (create-function :initarg :create-function + :initform ignore + :type function + :custom function + :documentation "The create function.") + (search-function :initarg :search-function + :initform ignore + :type function + :custom function + :documentation "The search function."))) + (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") (pop3 "pop3" "pop" "pop3s" "110" "995") (ssh "ssh" "22") @@ -81,11 +122,15 @@ p))) auth-source-protocols)) -(defvar auth-source-cache (make-hash-table :test 'equal) - "Cache for auth-source data") +(defvar auth-source-creation-defaults nil + "Defaults for creating token values. Usually let-bound.") + +(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1") + +(defvar auth-source-magic "auth-source-magic ") (defcustom auth-source-do-cache t - "Whether auth-source should cache information." + "Whether auth-source should cache information with `password-cache'." :group 'auth-source :version "23.2" ;; No Gnus :type `boolean) @@ -108,65 +153,71 @@ If the value is a function, debug messages are logged by calling (function :tag "Function that takes arguments like `message'") (const :tag "Don't log anything" nil))) -(defcustom auth-source-hide-passwords t - "Whether auth-source should hide passwords in log messages. -Only relevant if `auth-source-debug' is not nil." - :group 'auth-source - :version "23.2" ;; No Gnus - :type `boolean) - -(defcustom auth-sources '((:source "~/.authinfo.gpg") - (:source "~/.authinfo")) +(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo") "List of authentication sources. -The default will get login and password information from a .gpg -file, which you should set up with the EPA/EPG packages to be -encrypted. See the auth.info manual for details. +The default will get login and password information from +\"~/.authinfo.gpg\", which you should set up with the EPA/EPG +packages to be encrypted. If that file doesn't exist, it will +try the unencrypted version \"~/.authinfo\". + +See the auth.info manual for details. Each entry is the authentication type with optional properties. It's best to customize this with `M-x customize-variable' because the choices can get pretty complex." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type `(repeat :tag "Authentication Sources" - (list :tag "Source definition" - (const :format "" :value :source) - (choice :tag "Authentication backend choice" - (string :tag "Authentication Source (file)") - (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)" - (const :format "" :value :secrets) - (choice :tag "Collection to use" - (string :tag "Collection name") - (const :tag "Default" 'default) - (const :tag "Login" "login") - (const :tag "Temporary" "session")))) - (repeat :tag "Extra Parameters" :inline t - (choice :tag "Extra parameter" - (list :tag "Host (omit to match as a fallback)" - (const :format "" :value :host) - (choice :tag "Host (machine) choice" - (const :tag "Any" t) - (regexp :tag "Host (machine) regular expression"))) - (list :tag "Protocol (omit to match as a fallback)" - (const :format "" :value :protocol) - (choice :tag "Protocol" - (const :tag "Any" t) - ,@auth-source-protocols-customize)) - (list :tag "User (omit to match as a fallback)" :inline t - (const :format "" :value :user) - (choice :tag "Personality or username" - (const :tag "Any" t) - (string :tag "Specific user name")))))))) + (choice + (string :tag "Just a file") + (const :tag "Default Secrets API Collection" 'default) + (const :tag "Login Secrets API Collection" "secrets:login") + (const :tag "Temp Secrets API Collection" "secrets:session") + (list :tag "Source definition" + (const :format "" :value :source) + (choice :tag "Authentication backend choice" + (string :tag "Authentication Source (file)") + (list + :tag "Secret Service API/KWallet/GNOME Keyring" + (const :format "" :value :secrets) + (choice :tag "Collection to use" + (string :tag "Collection name") + (const :tag "Default" 'default) + (const :tag "Login" "login") + (const + :tag "Temporary" "session")))) + (repeat :tag "Extra Parameters" :inline t + (choice :tag "Extra parameter" + (list + :tag "Host" + (const :format "" :value :host) + (choice :tag "Host (machine) choice" + (const :tag "Any" t) + (regexp + :tag "Regular expression"))) + (list + :tag "Protocol" + (const :format "" :value :protocol) + (choice + :tag "Protocol" + (const :tag "Any" t) + ,@auth-source-protocols-customize)) + (list :tag "User" :inline t + (const :format "" :value :user) + (choice :tag "Personality/Username" + (const :tag "Any" t) + (string :tag "Name"))))))))) (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. If the value is not a list, symmetric encryption will be used." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type '(choice (const :tag "Symmetric encryption" t) - (repeat :tag "Recipient public keys" - (string :tag "Recipient public key")))) + (repeat :tag "Recipient public keys" + (string :tag "Recipient public key")))) ;; temp for debugging ;; (unintern 'auth-source-protocols) @@ -211,229 +262,801 @@ If the value is not a list, symmetric encryption will be used." ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) -(defun auth-get-source (entry) - "Return the source string of ENTRY, which is one entry in `auth-sources'. -If it is a Secret Service API, return the collection name, otherwise -the file name." - (let ((source (plist-get entry :source))) - (if (stringp source) - source - ;; Secret Service API. - (setq source (plist-get source :secrets)) - (when (eq source 'default) - (setq source (or (secrets-get-alias "default") "login"))) - (or source "session")))) - -(defun auth-source-pick (&rest spec) - "Parse `auth-sources' for matches of the SPEC plist. - -Common keys are :host, :protocol, and :user. A value of t in -SPEC means to always succeed in the match. A string value is -matched as a regex." - (let ((keys (loop for i below (length spec) by 2 collect (nth i spec))) - choices) - (dolist (choice (copy-tree auth-sources) choices) - (let ((source (plist-get choice :source)) - (match t)) - (when - (and - ;; Check existence of source. - (if (consp source) - ;; Secret Service API. - (member (auth-get-source choice) (secrets-list-collections)) - ;; authinfo file. - (file-exists-p source)) - - ;; Check keywords. - (dolist (k keys match) - (let* ((v (plist-get spec k)) - (choicev (if (plist-member choice k) - (plist-get choice k) t))) - (setq match - (and match - (or - ;; source always matches spec key - (eq t choicev) - ;; source key gives regex to match against spec - (and (stringp choicev) (string-match choicev v)) - ;; source key gives symbol to match against spec - (and (symbolp choicev) (eq choicev v)))))))) - - (add-to-list 'choices choice 'append)))))) - -(defun auth-source-retrieve (mode entry &rest spec) - "Retrieve MODE credentials according to SPEC from ENTRY." - (catch 'no-password - (let ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source)) - result) - (cond - ;; Secret Service API. - ((consp source) - (let ((coll (auth-get-source entry)) - item) - ;; Loop over candidates with a matching host attribute. - (dolist (elt (secrets-search-items coll :host host) item) - (when (and (or (not user) - (string-equal - user (secrets-get-attribute coll elt :user))) - (or (not prot) - (string-equal - prot (secrets-get-attribute coll elt :protocol)))) - (setq item elt) - (return elt))) - ;; Compose result. - (when item - (setq result - (mapcar (lambda (m) - (if (string-equal "password" m) - (or (secrets-get-secret coll item) - ;; When we do not find a password, - ;; we return nil anyway. - (throw 'no-password nil)) - (or (secrets-get-attribute coll item :user) - user))) - (if (consp mode) mode (list mode))))) - (if (consp mode) result (car result)))) - ;; Anything else is netrc. - (t - (let ((search (list source (list host) (list (format "%s" prot)) - (auth-source-protocol-defaults prot)))) - (setq result - (mapcar (lambda (m) - (if (string-equal "password" m) - (or (apply - 'netrc-machine-user-or-password m search) - ;; When we do not find a password, we - ;; return nil anyway. - (throw 'no-password nil)) - (or (apply - 'netrc-machine-user-or-password m search) - user))) - (if (consp mode) mode (list mode))))) - (if (consp mode) result (car result))))))) - -(defun auth-source-create (mode entry &rest spec) - "Create interactively credentials according to SPEC in ENTRY. -Return structure as specified by MODE." - (let* ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source)) - (name (concat (if user (format "%s@" user)) - host - (if prot (format ":%s" prot)))) - result) - (setq result - (mapcar - (lambda (m) - (cons - m - (cond - ((equal "password" m) - (let ((passwd (read-passwd - (format "Password for %s on %s: " prot host)))) - (cond - ;; Secret Service API. - ((consp source) - (apply - 'secrets-create-item - (auth-get-source entry) name passwd spec)) - (t)) ;; netrc not implemented yes. - passwd)) - ((equal "login" m) - (or user - (read-string - (format "User name for %s on %s (default %s): " prot host - (user-login-name)) - nil nil (user-login-name)))) - (t - "unknownuser")))) - (if (consp mode) mode (list mode)))) - ;; Allow the source to save the data. - (cond - ((consp source) - ;; Secret Service API -- not implemented. - ) - (t - ;; netrc interface. - (when (y-or-n-p (format "Do you want to save this password in %s? " - source)) - ;; the code below is almost same as `netrc-store-data' except - ;; the `epa-file-encrypt-to' hack (see bug#7487). - (with-temp-buffer - (when (file-exists-p source) - (insert-file-contents source)) - (when auth-source-gpg-encrypt-to - ;; making `epa-file-encrypt-to' local to this buffer lets - ;; epa-file skip the key selection query (see the - ;; `local-variable-p' check in `epa-file-write-region'). - (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) - (make-local-variable 'epa-file-encrypt-to)) - (if (listp auth-source-gpg-encrypt-to) - (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert (format "machine %s login %s password %s port %s\n" - host - (or user (cdr (assoc "login" result))) - (cdr (assoc "password" result)) - prot)) - (write-region (point-min) (point-max) source nil 'silent))))) - (if (consp mode) - (mapcar #'cdr result) - (cdar result)))) - -(defun auth-source-delete (entry &rest spec) - "Delete credentials according to SPEC in ENTRY." - (let ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source))) - (cond - ;; Secret Service API. - ((consp source) - (let ((coll (auth-get-source entry))) - ;; Loop over candidates with a matching host attribute. - (dolist (elt (secrets-search-items coll :host host)) - (when (and (or (not user) - (string-equal - user (secrets-get-attribute coll elt :user))) - (or (not prot) - (string-equal - prot (secrets-get-attribute coll elt :protocol)))) - (secrets-delete-item coll elt))))) - (t)))) ;; netrc not implemented yes. - -(defun auth-source-forget-user-or-password - (mode host protocol &optional username) - "Remove cached authentication token." - (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing - (remhash - (if username - (format "%s %s:%s %s" mode host protocol username) - (format "%s %s:%s" mode host protocol)) - auth-source-cache)) +;; (auth-source-backend-parse "myfile.gpg") +;; (auth-source-backend-parse 'default) +;; (auth-source-backend-parse "secrets:login") + +(defun auth-source-backend-parse (entry) + "Creates an auth-source-backend from an ENTRY in `auth-sources'." + (auth-source-backend-parse-parameters + entry + (cond + ;; take 'default and recurse to get it as a Secrets API default collection + ;; matching any user, host, and protocol + ((eq entry 'default) + (auth-source-backend-parse '(:source (:secrets default)))) + ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ" + ;; matching any user, host, and protocol + ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry)) + (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry))))) + ;; take just a file name and recurse to get it as a netrc file + ;; matching any user, host, and protocol + ((stringp entry) + (auth-source-backend-parse `(:source ,entry))) + + ;; a file name with parameters + ((stringp (plist-get entry :source)) + (auth-source-backend + (plist-get entry :source) + :source (plist-get entry :source) + :type 'netrc + :search-function 'auth-source-netrc-search + :create-function 'auth-source-netrc-create)) + + ;; the Secrets API. We require the package, in order to have a + ;; defined value for `secrets-enabled'. + ((and + (not (null (plist-get entry :source))) ; the source must not be nil + (listp (plist-get entry :source)) ; and it must be a list + (require 'secrets nil t) ; and we must load the Secrets API + secrets-enabled) ; and that API must be enabled + + ;; the source is either the :secrets key in ENTRY or + ;; if that's missing or nil, it's "session" + (let ((source (or (plist-get (plist-get entry :source) :secrets) + "session"))) + + ;; if the source is a symbol, we look for the alias named so, + ;; and if that alias is missing, we use "login" + (when (symbolp source) + (setq source (or (secrets-get-alias (symbol-name source)) + "login"))) + + (auth-source-backend + (format "Secrets API (%s)" source) + :source source + :type 'secrets + :search-function 'auth-source-secrets-search + :create-function 'auth-source-secrets-create))) + + ;; none of them + (t + (auth-source-do-debug + "auth-source-backend-parse: invalid backend spec: %S" entry) + (auth-source-backend + "Empty" + :source "" + :type 'ignore))))) + +(defun auth-source-backend-parse-parameters (entry backend) + "Fills in the extra auth-source-backend parameters of ENTRY. +Using the plist ENTRY, get the :host, :protocol, and :user search +parameters. Accepts :port as an alias to :protocol." + (let ((entry (if (stringp entry) + nil + entry)) + val) + (when (setq val (plist-get entry :host)) + (oset backend host val)) + (when (setq val (plist-get entry :user)) + (oset backend user val)) + ;; accept :port as an alias for :protocol + (when (setq val (or (plist-get entry :protocol) (plist-get entry :port))) + (oset backend protocol val))) + backend) + +;; (mapcar 'auth-source-backend-parse auth-sources) + +(defun* auth-source-search (&rest spec + &key type max host user protocol secret + create delete + &allow-other-keys) + "Search or modify authentication backends according to SPEC. + +This function parses `auth-sources' for matches of the SPEC +plist. It can optionally create or update an authentication +token if requested. A token is just a standard Emacs property +list with a :secret property that can be a function; all the +other properties will always hold scalar values. + +Typically the :secret property, if present, contains a password. + +Common search keys are :max, :host, :protocol, and :user. In +addition, :create specifies how tokens will be or created. +Finally, :type can specify which backend types you want to check. + +A string value is always matched literally. A symbol is matched +as its string value, literally. All the SPEC values can be +single values (symbol or string) or lists thereof (in which case +any of the search terms matches). + +:create t means to create a token if possible. + +A new token will be created if no matching tokens were found. +The new token will have only the keys the backend requires. For +the netrc backend, for instance, that's the user, host, and +protocol keys. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host \"mine\" :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create t)) + +which says: + +\"Search for any entry matching host 'mine' in backends of type + 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and protocol. The host will be + 'mine'. We prompt for the user with default 'defaultUser' and + for the protocol without a default. We will not prompt for A, Q, + or P. The resulting token will only have keys user, host, and + protocol.\" + +:create '(A B C) also means to create a token if possible. + +The behavior is like :create t but if the list contains any +parameter, that parameter will be required in the resulting +token. The value for that parameter will be obtained from the +search parameters or from user input. If any queries are needed, +the alist `auth-source-creation-defaults' will be checked for the +default prompt. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create '(A B Q))) + +which says: + +\"Search for any entry matching host 'nonesuch' + or 'twosuch' in backends of type 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and protocol. The host will be + 'nonesuch' and Q will be 'qqqq'. We prompt for A with default + 'default A', for B and protocol with default nil, and for the + user with default 'defaultUser'. We will not prompt for Q. The + resulting token will have keys user, host, protocol, A, B, and Q. + It will not have P with any value, even though P is used in the + search to find only entries that have P set to 'pppp'.\" + +When multiple values are specified in the search parameter, the +first one is used for creation. So :host (X Y Z) would create a +token for host X, for instance. + +This creation can fail if the search was not specific enough to +create a new token (it's up to the backend to decide that). You +should `catch' the backend-specific error as usual. Some +backends (netrc, at least) will prompt the user rather than throw +an error. + +:delete t means to delete any found entries. nil by default. +Use `auth-source-delete' in ELisp code instead of calling +`auth-source-search' directly with this parameter. + +:type (X Y Z) will check only those backend types. 'netrc and +'secrets are the only ones supported right now. + +:max N means to try to return at most N items (defaults to 1). +When 0 the function will return just t or nil to indicate if any +matches were found. More than N items may be returned, depending +on the search and the backend. + +:host (X Y Z) means to match only hosts X, Y, or Z according to +the match rules above. Defaults to t. + +:user (X Y Z) means to match only users X, Y, or Z according to +the match rules above. Defaults to t. + +:protocol (P Q R) means to match only protocols P, Q, or R. +Defaults to t. + +:K (V1 V2 V3) for any other key K will match values V1, V2, or +V3 (note the match rules above). + +The return value is a list with at most :max tokens. Each token +is a plist with keys :backend :host :protocol :user, plus any other +keys provided by the backend (notably :secret). But note the +exception for :max 0, which see above. + +The token's :secret key can hold a function. In that case you +must call it to obtain the actual value." + (let* ((backends (mapcar 'auth-source-backend-parse auth-sources)) + (max (or max 1)) + (ignored-keys '(:create :delete :max)) + (keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + (found (auth-source-recall spec)) + filtered-backends accessor-key found-here goal) + + (if (and found auth-source-do-cache) + (auth-source-do-debug + "auth-source-search: found %d CACHED results matching %S" + (length found) spec) + + (assert + (or (eq t create) (listp create)) t + "Invalid auth-source :create parameter (must be nil, t, or a list): %s %s") + + (setq filtered-backends (copy-sequence backends)) + (dolist (backend backends) + (dolist (key keys) + ;; ignore invalid slots + (condition-case signal + (unless (eval `(auth-source-search-collection + (plist-get spec key) + (oref backend ,key))) + (setq filtered-backends (delq backend filtered-backends)) + (return)) + (invalid-slot-name)))) + + (auth-source-do-debug + "auth-source-search: found %d backends matching %S" + (length filtered-backends) spec) + + ;; (debug spec "filtered" filtered-backends) + (setq goal max) + (dolist (backend filtered-backends) + (setq found-here (apply + (slot-value backend 'search-function) + :backend backend + :create create + :delete delete + spec)) + + ;; if max is 0, as soon as we find something, return it + (when (and (zerop max) (> 0 (length found-here))) + (return t)) + + ;; decrement the goal by the number of new results + (decf goal (length found-here)) + ;; and append the new results to the full list + (setq found (append found found-here)) + + (auth-source-do-debug + "auth-source-search: found %d results (max %d/%d) in %S matching %S" + (length found-here) max goal backend spec) + + ;; return full list if the goal is 0 or negative + (when (zerop (max 0 goal)) + (return found)) + + ;; change the :max parameter in the spec to the goal + (setq spec (plist-put spec :max goal))) + + (when (and found auth-source-do-cache) + (auth-source-remember spec found))) + + found)) + +;;; (auth-source-search :max 1) +;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) +;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) +;;; (auth-source-search :host "nonesuch" :type 'secrets) + +(defun* auth-source-delete (&rest spec + &key delete + &allow-other-keys) + "Delete entries from the authentication backends according to SPEC. +Calls `auth-source-search' with the :delete property in SPEC set to t. +The backend may not actually delete the entries. + +Returns the deleted entries." + (auth-source-search (plist-put spec :delete t))) + +(defun auth-source-search-collection (collection value) + "Returns t is VALUE is t or COLLECTION is t or contains VALUE." + (when (and (atom collection) (not (eq t collection))) + (setq collection (list collection))) + + ;; (debug :collection collection :value value) + (or (eq collection t) + (eq value t) + (equal collection value) + (member value collection))) (defun auth-source-forget-all-cached () - "Forget all cached auth-source authentication tokens." + "Forget all cached auth-source data." (interactive) - (setq auth-source-cache (make-hash-table :test 'equal))) + (loop for sym being the symbols of password-data + ;; when the symbol name starts with auth-source-magic + when (string-match (concat "^" auth-source-magic) + (symbol-name sym)) + ;; remove that key + do (password-cache-remove (symbol-name sym)))) + +(defun auth-source-remember (spec found) + "Remember FOUND search results for SPEC." + (password-cache-add + (concat auth-source-magic (format "%S" spec)) found)) + +(defun auth-source-recall (spec) + "Recall FOUND search results for SPEC." + (password-read-from-cache + (concat auth-source-magic (format "%S" spec)))) + +(defun auth-source-forget (spec) + "Forget any cached data matching SPEC exactly. + +This is the same SPEC you passed to `auth-source-search'. +Returns t or nil for forgotten or not found." + (password-cache-remove (concat auth-source-magic (format "%S" spec)))) + +;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym)) + +;;; (auth-source-remember '(:host "wedd") '(4 5 6)) +;;; (auth-source-remember '(:host "xedd") '(1 2 3)) +;;; (auth-source-recall '(:host "xedd")) +;;; (auth-source-recall '(:host t)) +;;; (auth-source-forget+ :host t) + +(defun* auth-source-forget+ (&rest spec &allow-other-keys) + "Forget any cached data matching SPEC. Returns forgotten count. + +This is not a full `auth-source-search' spec but works similarly. +For instance, \(:host \"myhost\" \"yourhost\") would find all the +cached data that was found with a search for those two hosts, +while \(:host t) would find all host entries." + (let ((count 0) + sname) + (loop for sym being the symbols of password-data + ;; when the symbol name matches with auth-source-magic + when (and (setq sname (symbol-name sym)) + (string-match (concat "^" auth-source-magic "\\(.+\\)") + sname) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (read (match-string 1 sname)))) + ;; remove that key + do (progn + (password-cache-remove sname) + (incf count))) + count)) + +(defun auth-source-specmatchp (spec stored) + (let ((keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (not (eq + (dolist (key keys) + (unless (auth-source-search-collection (plist-get stored key) + (plist-get spec key)) + (return 'no))) + 'no)))) + +;;; Backend specific parsing: netrc/authinfo backend + +;;; (auth-source-netrc-parse "~/.authinfo.gpg") +(defun* auth-source-netrc-parse (&rest + spec + &key file max host user protocol delete + &allow-other-keys) + "Parse FILE and return a list of all entries in the file. +Note that the MAX parameter is used so we can exit the parse early." + (if (listp file) + ;; We got already parsed contents; just return it. + file + (when (file-exists-p file) + (with-temp-buffer + (let ((tokens '("machine" "host" "default" "login" "user" + "password" "account" "macdef" "force" + "port" "protocol")) + (max (or max 5000)) ; sanity check: default to stop at 5K + (modified 0) + alist elem result pair) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (and (not (eobp)) + (> max 0)) + + (narrow-to-region (point) (point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + ;; Skip lines that begin with a "#". + (if (eq (char-after) ?#) + (goto-char (point-max)) + (unless (eobp) + (setq elem + (if (= (following-char) ?\") + (read (current-buffer)) + (buffer-substring + (point) (progn (skip-chars-forward "^\t ") + (point))))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil))))))) + + (when (and alist + (> max 0) + (auth-source-search-collection + host + (or + (aget alist "machine") + (aget alist "host"))) + (auth-source-search-collection + user + (or + (aget alist "login") + (aget alist "account") + (aget alist "user"))) + (auth-source-search-collection + protocol + (or + (aget alist "port") + (aget alist "protocol")))) + (decf max) + (push (nreverse alist) result) + ;; to delete a line, we just comment it out + (when delete + (goto-char (point-min)) + (insert "#") + (incf modified))) + (setq alist nil + pair nil) + (widen) + (forward-line 1)) + + (when (< 0 modified) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Save file %s? (%d modifications)" + file modified)) + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-parse: modified %d lines in %s" + modified file))) + + (nreverse result)))))) + +(defun auth-source-netrc-normalize (alist) + (mapcar (lambda (entry) + (let (ret item) + (while (setq item (pop entry)) + (let ((k (car item)) + (v (cdr item))) + + ;; apply key aliases + (setq k (cond ((member k '("machine")) "host") + ((member k '("login" "account")) "user") + ((member k '("protocol")) "port") + ((member k '("password")) "secret") + (t k))) + + ;; send back the secret in a function (lexical binding) + (when (equal k "secret") + (setq v (lexical-let ((v v)) + (lambda () v)))) + + (setq ret (plist-put ret + (intern (concat ":" k)) + v)) + )) + ret)) + alist)) + +;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) +;;; (funcall secret) + +(defun* auth-source-netrc-search (&rest + spec + &key backend create delete + type max host user protocol + &allow-other-keys) +"Given a property list SPEC, return search matches from the :backend. +See `auth-source-search' for details on SPEC." + ;; just in case, check that the type is correct (null or same as the backend) + (assert (or (null type) (eq type (oref backend type))) + t "Invalid netrc search: %s %s") + + (let ((results (auth-source-netrc-normalize + (auth-source-netrc-parse + :max max + :delete delete + :file (oref backend source) + :host (or host t) + :user (or user t) + :protocol (or protocol t))))) + + ;; if we need to create an entry AND none were found to match + (when (and create + (= 0 (length results))) + + ;; create based on the spec + (apply (slot-value backend 'create-function) spec) + ;; turn off the :create key + (setq spec (plist-put spec :create nil)) + ;; run the search again to get the updated data + ;; the result will be returned, even if the search fails + (setq results (apply 'auth-source-netrc-search spec))) + + results)) + +;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) +;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) + +(defun* auth-source-netrc-create (&rest spec + &key backend + secret host user protocol create + &allow-other-keys) + (let* ((base-required '(host user protocol secret)) + ;; we know (because of an assertion in auth-source-search) that the + ;; :create parameter is either t or a list (which includes nil) + (create-extra (if (eq t create) nil create)) + (required (append base-required create-extra)) + (file (oref backend source)) + (add "") + ;; `valist' is an alist + valist) + + ;; only for base required elements (defined as function parameters): + ;; fill in the valist with whatever data we may have from the search + ;; we take the first value if it's a list, the whole value otherwise + (dolist (br base-required) + (when (symbol-value br) + (aput 'valist br (if (listp (symbol-value br)) + (nth 0 (symbol-value br)) + (symbol-value br))))) + + ;; for extra required elements, see if the spec includes a value for them + (dolist (er create-extra) + (let ((name (concat ":" (symbol-name er))) + (keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (dolist (k keys) + (when (equal (symbol-name k) name) + (aput 'valist er (plist-get spec k)))))) + + ;; for each required element + (dolist (r required) + (let* ((data (aget valist r)) + (given-default (aget auth-source-creation-defaults r)) + ;; the defaults are simple + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + ;; note we need this empty string + ((and (not given-default) (eq r 'protocol)) + "") + (t given-default))) + ;; the prompt's default string depends on the data so far + (default-string (if (and default (< 0 (length default))) + (format " (default %s)" default) + " (no default)")) + ;; the prompt should also show what's entered so far + (user-value (aget valist 'user)) + (host-value (aget valist 'host)) + (protocol-value (aget valist 'protocol)) + (info-so-far (concat (if user-value + (format "%s@" user-value) + "[USER?]") + (if host-value + (format "%s" host-value) + "[HOST?]") + (if protocol-value + ;; this distinguishes protocol between + (if (zerop (length protocol-value)) + "" ; 'entered as "no default"' vs. + (format ":%s" protocol-value)) ; given + ;; and this is when the protocol is unknown + "[PROTOCOL?]")))) -;; (progn -;; (auth-source-forget-all-cached) -;; (list -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other") -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz") -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe"))) + ;; now prompt if the search SPEC did not include a required key; + ;; take the result and put it in `data' AND store it in `valist' + (aput 'valist r + (setq data + (cond + ((and (null data) (eq r 'secret)) + ;; special case prompt for passwords + (read-passwd (format "Password for %s: " info-so-far))) + ((null data) + (read-string + (format "Enter %s for %s%s: " + r info-so-far default-string) + nil nil default)) + (t data)))) + + ;; when r is not an empty string... + (when (and (stringp data) + (< 0 (length data))) + ;; append the key (the symbol name of r) and the value in r + (setq add (concat add + (format "%s%s %S" + ;; prepend a space + (if (zerop (length add)) "" " ") + ;; remap auth-source tokens to netrc + (case r + ('user "login") + ('host "machine") + ('secret "password") + ('protocol "port") + (t (symbol-name r))) + ;; the value will be printed in %S format + data)))))) + + (with-temp-buffer + (when (file-exists-p file) + (insert-file-contents file)) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + (goto-char (point-max)) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Add to file %s: line [%s]" file add)) + (unless (bolp) + (insert "\n")) + (insert add "\n") + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-create: wrote 1 new line to %s" + file))))) + +;;; Backend specific parsing: Secrets API backend + +;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t)) +;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t)) +;;; (let ((auth-sources '(default))) (auth-source-search :max 1)) +;;; (let ((auth-sources '(default))) (auth-source-search)) +;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1)) +;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git")) + +(defun* auth-source-secrets-search (&rest + spec + &key backend create delete label + type max host user protocol + &allow-other-keys) + "Search the Secrets API; spec is like `auth-source'. + +The :label key specifies the item's label. It is the only key +that can specify a substring. Any :label value besides a string +will allow any label. + +All other search keys must match exactly. If you need substring +matching, do a wider search and narrow it down yourself. + +You'll get back all the properties of the token as a plist. + +Here's an example that looks for the first item in the 'login' +Secrets collection: + + \(let ((auth-sources '(\"secrets:login\"))) + (auth-source-search :max 1) + +Here's another that looks for the first item in the 'login' +Secrets collection whose label contains 'gnus': + + \(let ((auth-sources '(\"secrets:login\"))) + (auth-source-search :max 1 :label \"gnus\") + +And this one looks for the first item in the 'login' Secrets +collection that's a Google Chrome entry for the git.gnus.org site +login: + + \(let ((auth-sources '(\"secrets:login\"))) + (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\")) +" + + ;; TODO + (assert (not create) nil + "The Secrets API auth-source backend doesn't support creation yet") + ;; TODO + ;; (secrets-delete-item coll elt) + (assert (not delete) nil + "The Secrets API auth-source backend doesn't support deletion yet") + + (let* ((coll (oref backend source)) + (max (or max 5000)) ; sanity check: default to stop at 5K + (ignored-keys '(:create :delete :max :backend :label)) + (search-keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + ;; build a search spec without the ignored keys + ;; if a search key is nil or t (match anything), we skip it + (search-spec (mapcan (lambda (k) (if (or (null (plist-get spec k)) + (eq t (plist-get spec k))) + nil + (list k (plist-get spec k)))) + search-keys)) + ;; needed keys (always including host, login, protocol, and secret) + (returned-keys (remove-duplicates (append + '(:host :login :protocol :secret) + search-keys))) + (items (loop for item in (apply 'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item)) + ;; TODO: respect max in `secrets-search-items', not after the fact + (items (subseq items 0 (min (length items) max))) + ;; convert the item name to a full plist + (items (mapcar (lambda (item) + (append + ;; make an entry for the secret (password) element + (list + :secret + (lexical-let ((v (secrets-get-secret coll item))) + (lambda () v))) + ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist + (mapcan (lambda (entry) + (list (car entry) (cdr entry))) + (secrets-get-attributes coll item)))) + items)) + ;; ensure each item has each key in `returned-keys' + (items (mapcar (lambda (plist) + (append + (mapcan (lambda (req) + (if (plist-get plist req) + nil + (list req nil))) + returned-keys) + plist)) + items))) + items)) + +(defun* auth-source-secrets-create (&rest + spec + &key backend type max host user protocol + &allow-other-keys) + ;; TODO + ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) + (debug spec)) + +;;; older API + +;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") + +;; deprecate the old interface +(make-obsolete 'auth-source-user-or-password + 'auth-source-search "Emacs 24.1") +(make-obsolete 'auth-source-forget-user-or-password + 'auth-source-forget "Emacs 24.1") (defun auth-source-user-or-password (mode host protocol &optional username create-missing delete-existing) "Find MODE (string or list of strings) matching HOST and PROTOCOL. +DEPRECATED in favor of `auth-source-search'! + USERNAME is optional and will be used as \"login\" in a search across the Secret Service API (see secrets.el) if the resulting items don't have a username. This means that if you search for @@ -452,8 +1075,9 @@ stored in the password database which matches best (see MODE can be \"login\" or \"password\"." (auth-source-do-debug - "auth-source-user-or-password: get %s for %s (%s) + user=%s" + "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" mode host protocol username) + (let* ((listy (listp mode)) (mode (if listy mode (list mode))) (cname (if username @@ -461,70 +1085,44 @@ MODE can be \"login\" or \"password\"." (format "%s %s:%s" mode host protocol))) (search (list :host host :protocol protocol)) (search (if username (append search (list :user username)) search)) - (found (if (not delete-existing) - (gethash cname auth-source-cache) - (remhash cname auth-source-cache) - nil))) + (search (if create-missing + (append search (list :create t)) + search)) + (search (if delete-existing + (append search (list :delete t)) + search)) + ;; (found (if (not delete-existing) + ;; (gethash cname auth-source-cache) + ;; (remhash cname auth-source-cache) + ;; nil))) + (found nil)) (if found (progn (auth-source-do-debug - "auth-source-user-or-password: cached %s=%s for %s (%s) + %s" + "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s" mode ;; don't show the password - (if (and (member "password" mode) auth-source-hide-passwords) + (if (and (member "password" mode) t) "SECRET" found) host protocol username) found) ; return the found data - ;; else, if not found - (let ((choices (apply 'auth-source-pick search))) - (dolist (choice choices) - (if delete-existing - (apply 'auth-source-delete choice search) - (setq found (apply 'auth-source-retrieve mode choice search))) - (and found (return found))) - - ;; We haven't found something, so we will create it interactively. - (when (and (not found) create-missing) - (setq found (apply 'auth-source-create - mode (if choices - (car choices) - (car auth-sources)) - search))) - - ;; Cache the result. - (when found - (auth-source-do-debug - "auth-source-user-or-password: found %s=%s for %s (%s) + %s" - mode - ;; don't show the password - (if (and (member "password" mode) auth-source-hide-passwords) - "SECRET" found) - host protocol username) - (setq found (if listy found (car-safe found))) - (when auth-source-do-cache - (puthash cname found auth-source-cache))) - - found)))) - -(defun auth-source-protocol-defaults (protocol) - "Return a list of default ports and names for PROTOCOL." - (cdr-safe (assoc protocol auth-source-protocols))) - -(defun auth-source-user-or-password-imap (mode host) - (auth-source-user-or-password mode host 'imap)) - -(defun auth-source-user-or-password-pop3 (mode host) - (auth-source-user-or-password mode host 'pop3)) - -(defun auth-source-user-or-password-ssh (mode host) - (auth-source-user-or-password mode host 'ssh)) - -(defun auth-source-user-or-password-sftp (mode host) - (auth-source-user-or-password mode host 'sftp)) + ;; else, if not found, search with a max of 1 + (let ((choice (nth 0 (apply 'auth-source-search + (append '(:max 1) search))))) + (when choice + (dolist (m mode) + (cond + ((equal "password" m) + (push (if (plist-get choice :secret) + (funcall (plist-get choice :secret)) + nil) found)) + ((equal "login" m) + (push (plist-get choice :user) found))))) + (setq found (nreverse found)) + (setq found (if listy found (car-safe found))))) -(defun auth-source-user-or-password-smtp (mode host) - (auth-source-user-or-password mode host 'smtp)) + found)) (provide 'auth-source) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 54797b2a518..3e1630804f7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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))))))) diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index a06a510ecdd..bfd17055ea5 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -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)))) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index f98c195eada..6e6ef76c0c1 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -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 () diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index a6fe6b1489b..a5a001f7e11 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -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") diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index eb2dd004638..4b42637978e 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -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 diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index d115f40528b..c9a0df20590 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -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 diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index eb65bb7a60f..0e3d54408fd 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -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) \ diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 2abfea9ac6b..69ca927d5e7 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -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) diff --git a/lisp/net/imap-hash.el b/lisp/net/imap-hash.el deleted file mode 100644 index a07277cee68..00000000000 --- a/lisp/net/imap-hash.el +++ /dev/null @@ -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) - diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el deleted file mode 100644 index 4157265b0e1..00000000000 --- a/lisp/net/tramp-imap.el +++ /dev/null @@ -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") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5d0f3935884..9be093743b5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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))) diff --git a/lisp/password-cache.el b/lisp/password-cache.el index fcae55ad597..8738aa65a9f 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -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) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f90d29bf009..de1debd6456 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -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) ?&) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 0d738700cc7..c7bb93f73e7 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -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 diff --git a/lisp/simple.el b/lisp/simple.el index f19525aba4c..4d2a0e69836 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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)) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index f75d8b57909..79df6135806 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -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))) diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 2aea75aa427..cadcdec29b4 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -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))) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 468d12057ab..d930a1bec69 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -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. " diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 11ffc9a5e36..fa731e77a6e 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -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. - - ;; `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. - - (re-search-backward log-view-message-re nil 'move)) +(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)))))))) + +(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. + +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) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 9f86a28a575..a36fdc60d15 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -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)))) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index de729c969ae..3b4d0e5f421 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -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) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 10348544357..d283c39362a 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -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 diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index be0f568d304..815bdbfc5bf 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -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) diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 60defac0b18..9a9c1fd3369 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -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. diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index 19c2440989d..9c9a007bc15 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -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; diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c index 7c9a56d2aeb..a3e1cb3b432 100644 --- a/lwlib/lwlib-utils.c +++ b/lwlib/lwlib-utils.c @@ -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> diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 065d81e1fde..5b97f2bf999 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -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); diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h index 1f0f973d7b9..fad2aafb3d7 100644 --- a/lwlib/xlwmenu.h +++ b/lwlib/xlwmenu.h @@ -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" diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h index b7ea9de54f7..0aca2f8ea89 100644 --- a/lwlib/xlwmenuP.h +++ b/lwlib/xlwmenuP.h @@ -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; diff --git a/make-dist b/make-dist index 37e0fb3e641..ee0efb04c3a 100755 --- a/make-dist +++ b/make-dist @@ -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 diff --git a/src/ChangeLog b/src/ChangeLog index b56a2ce8dff..b1f60025263 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -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> diff --git a/src/alloc.c b/src/alloc.c index f75903aab5a..566c6fe00b9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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); diff --git a/src/buffer.c b/src/buffer.c index 05cc12eea6f..49ae4bbede2 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -162,7 +162,7 @@ DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0, Value is nil if OBJECT is not a buffer or if it has been killed. */) (Lisp_Object object) { - return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name)) + return ((BUFFERP (object) && ! NILP (B_ (XBUFFER (object), name))) ? Qt : Qnil); } @@ -266,8 +266,8 @@ See also `find-buffer-visiting'. */) { buf = Fcdr (XCAR (tail)); if (!BUFFERP (buf)) continue; - if (!STRINGP (XBUFFER (buf)->filename)) continue; - tem = Fstring_equal (XBUFFER (buf)->filename, filename); + if (!STRINGP (B_ (XBUFFER (buf), filename))) continue; + tem = Fstring_equal (B_ (XBUFFER (buf), filename), filename); if (!NILP (tem)) return buf; } @@ -283,8 +283,8 @@ get_truename_buffer (register Lisp_Object filename) { buf = Fcdr (XCAR (tail)); if (!BUFFERP (buf)) continue; - if (!STRINGP (XBUFFER (buf)->file_truename)) continue; - tem = Fstring_equal (XBUFFER (buf)->file_truename, filename); + if (!STRINGP (B_ (XBUFFER (buf), file_truename))) continue; + tem = Fstring_equal (B_ (XBUFFER (buf), file_truename), filename); if (!NILP (tem)) return buf; } @@ -353,7 +353,7 @@ even if it is dead. The return value is never nil. */) b->newline_cache = 0; b->width_run_cache = 0; - b->width_table = Qnil; + B_ (b, width_table) = Qnil; b->prevent_redisplay_optimizations_p = 1; /* Put this on the chain of all buffers including killed ones. */ @@ -362,22 +362,22 @@ even if it is dead. The return value is never nil. */) /* An ordinary buffer normally doesn't need markers to handle BEGV and ZV. */ - b->pt_marker = Qnil; - b->begv_marker = Qnil; - b->zv_marker = Qnil; + B_ (b, pt_marker) = Qnil; + B_ (b, begv_marker) = Qnil; + B_ (b, zv_marker) = Qnil; name = Fcopy_sequence (buffer_or_name); STRING_SET_INTERVALS (name, NULL_INTERVAL); - b->name = name; + B_ (b, name) = name; - b->undo_list = (SREF (name, 0) != ' ') ? Qnil : Qt; + B_ (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; reset_buffer (b); reset_buffer_local_variables (b, 1); - b->mark = Fmake_marker (); + B_ (b, mark) = Fmake_marker (); BUF_MARKERS (b) = NULL; - b->name = name; + B_ (b, name) = name; /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); @@ -486,7 +486,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) /* Get (a copy of) the alist of Lisp-level local variables of FROM and install that in TO. */ - to->local_var_alist = buffer_lisp_local_variables (from); + B_ (to, local_var_alist) = buffer_lisp_local_variables (from); } DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, @@ -512,7 +512,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) base_buffer = Fget_buffer (base_buffer); if (NILP (base_buffer)) error ("No such buffer: `%s'", SDATA (tem)); - if (NILP (XBUFFER (base_buffer)->name)) + if (NILP (B_ (XBUFFER (base_buffer), name))) error ("Base buffer has been killed"); if (SCHARS (name) == 0) @@ -536,7 +536,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) b->newline_cache = 0; b->width_run_cache = 0; - b->width_table = Qnil; + B_ (b, width_table) = Qnil; /* Put this on the chain of all buffers including killed ones. */ b->next = all_buffers; @@ -544,7 +544,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) name = Fcopy_sequence (name); STRING_SET_INTERVALS (name, NULL_INTERVAL); - b->name = name; + B_ (b, name) = name; reset_buffer (b); reset_buffer_local_variables (b, 1); @@ -553,57 +553,57 @@ CLONE nil means the indirect buffer's state is reset to default values. */) XSETBUFFER (buf, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); - b->mark = Fmake_marker (); - b->name = name; + B_ (b, mark) = Fmake_marker (); + B_ (b, name) = name; /* The multibyte status belongs to the base buffer. */ - b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters; + B_ (b, enable_multibyte_characters) = B_ (b->base_buffer, enable_multibyte_characters); /* Make sure the base buffer has markers for its narrowing. */ - if (NILP (b->base_buffer->pt_marker)) + if (NILP (B_ (b->base_buffer, pt_marker))) { - b->base_buffer->pt_marker = Fmake_marker (); - set_marker_both (b->base_buffer->pt_marker, base_buffer, + B_ (b->base_buffer, pt_marker) = Fmake_marker (); + set_marker_both (B_ (b->base_buffer, pt_marker), base_buffer, BUF_PT (b->base_buffer), BUF_PT_BYTE (b->base_buffer)); } - if (NILP (b->base_buffer->begv_marker)) + if (NILP (B_ (b->base_buffer, begv_marker))) { - b->base_buffer->begv_marker = Fmake_marker (); - set_marker_both (b->base_buffer->begv_marker, base_buffer, + B_ (b->base_buffer, begv_marker) = Fmake_marker (); + set_marker_both (B_ (b->base_buffer, begv_marker), base_buffer, BUF_BEGV (b->base_buffer), BUF_BEGV_BYTE (b->base_buffer)); } - if (NILP (b->base_buffer->zv_marker)) + if (NILP (B_ (b->base_buffer, zv_marker))) { - b->base_buffer->zv_marker = Fmake_marker (); - set_marker_both (b->base_buffer->zv_marker, base_buffer, + B_ (b->base_buffer, zv_marker) = Fmake_marker (); + set_marker_both (B_ (b->base_buffer, zv_marker), base_buffer, BUF_ZV (b->base_buffer), BUF_ZV_BYTE (b->base_buffer)); - XMARKER (b->base_buffer->zv_marker)->insertion_type = 1; + XMARKER (B_ (b->base_buffer, zv_marker))->insertion_type = 1; } if (NILP (clone)) { /* Give the indirect buffer markers for its narrowing. */ - b->pt_marker = Fmake_marker (); - set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b)); - b->begv_marker = Fmake_marker (); - set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); - b->zv_marker = Fmake_marker (); - set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b)); - XMARKER (b->zv_marker)->insertion_type = 1; + B_ (b, pt_marker) = Fmake_marker (); + set_marker_both (B_ (b, pt_marker), buf, BUF_PT (b), BUF_PT_BYTE (b)); + B_ (b, begv_marker) = Fmake_marker (); + set_marker_both (B_ (b, begv_marker), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); + B_ (b, zv_marker) = Fmake_marker (); + set_marker_both (B_ (b, zv_marker), buf, BUF_ZV (b), BUF_ZV_BYTE (b)); + XMARKER (B_ (b, zv_marker))->insertion_type = 1; } else { struct buffer *old_b = current_buffer; clone_per_buffer_values (b->base_buffer, b); - b->filename = Qnil; - b->file_truename = Qnil; - b->display_count = make_number (0); - b->backed_up = Qnil; - b->auto_save_file_name = Qnil; + B_ (b, filename) = Qnil; + B_ (b, file_truename) = Qnil; + B_ (b, display_count) = make_number (0); + B_ (b, backed_up) = Qnil; + B_ (b, auto_save_file_name) = Qnil; set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); Fset (intern ("buffer-file-number"), Qnil); @@ -647,34 +647,34 @@ delete_all_overlays (struct buffer *b) void reset_buffer (register struct buffer *b) { - b->filename = Qnil; - b->file_truename = Qnil; - b->directory = (current_buffer) ? current_buffer->directory : Qnil; + B_ (b, filename) = Qnil; + B_ (b, file_truename) = Qnil; + B_ (b, directory) = (current_buffer) ? B_ (current_buffer, directory) : Qnil; b->modtime = 0; b->modtime_size = -1; - XSETFASTINT (b->save_length, 0); + XSETFASTINT (B_ (b, save_length), 0); b->last_window_start = 1; /* It is more conservative to start out "changed" than "unchanged". */ b->clip_changed = 0; b->prevent_redisplay_optimizations_p = 1; - b->backed_up = Qnil; + B_ (b, backed_up) = Qnil; BUF_AUTOSAVE_MODIFF (b) = 0; b->auto_save_failure_time = -1; - b->auto_save_file_name = Qnil; - b->read_only = Qnil; + B_ (b, auto_save_file_name) = Qnil; + B_ (b, read_only) = Qnil; b->overlays_before = NULL; b->overlays_after = NULL; b->overlay_center = BEG; - b->mark_active = Qnil; - b->point_before_scroll = Qnil; - b->file_format = Qnil; - b->auto_save_file_format = Qt; - b->last_selected_window = Qnil; - XSETINT (b->display_count, 0); - b->display_time = Qnil; - b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters; - b->cursor_type = buffer_defaults.cursor_type; - b->extra_line_spacing = buffer_defaults.extra_line_spacing; + B_ (b, mark_active) = Qnil; + B_ (b, point_before_scroll) = Qnil; + B_ (b, file_format) = Qnil; + B_ (b, auto_save_file_format) = Qt; + B_ (b, last_selected_window) = Qnil; + XSETINT (B_ (b, display_count), 0); + B_ (b, display_time) = Qnil; + B_ (b, enable_multibyte_characters) = B_ (&buffer_defaults, enable_multibyte_characters); + B_ (b, cursor_type) = B_ (&buffer_defaults, cursor_type); + B_ (b, extra_line_spacing) = B_ (&buffer_defaults, extra_line_spacing); b->display_error_modiff = 0; } @@ -698,10 +698,10 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) things that depend on the major mode. default-major-mode is handled at a higher level. We ignore it here. */ - b->major_mode = Qfundamental_mode; - b->keymap = Qnil; - b->mode_name = QSFundamental; - b->minor_modes = Qnil; + B_ (b, major_mode) = Qfundamental_mode; + B_ (b, keymap) = Qnil; + B_ (b, mode_name) = QSFundamental; + B_ (b, minor_modes) = Qnil; /* If the standard case table has been altered and invalidated, fix up its insides first. */ @@ -710,22 +710,22 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) Fset_standard_case_table (Vascii_downcase_table); - b->downcase_table = Vascii_downcase_table; - b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; - b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; - b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; - b->invisibility_spec = Qt; + B_ (b, downcase_table) = Vascii_downcase_table; + B_ (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; + B_ (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; + B_ (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; + B_ (b, invisibility_spec) = Qt; #ifndef DOS_NT - b->buffer_file_type = Qnil; + B_ (b, buffer_file_type) = Qnil; #endif /* Reset all (or most) per-buffer variables to their defaults. */ if (permanent_too) - b->local_var_alist = Qnil; + B_ (b, local_var_alist) = Qnil; else { Lisp_Object tmp, prop, last = Qnil; - for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp)) + for (tmp = B_ (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) { /* If permanent-local, keep it. */ @@ -755,7 +755,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) } /* Delete this local variable. */ else if (NILP (last)) - b->local_var_alist = XCDR (tmp); + B_ (b, local_var_alist) = XCDR (tmp); else XSETCDR (last, XCDR (tmp)); } @@ -830,9 +830,9 @@ Return nil if BUFFER has been killed. */) (register Lisp_Object buffer) { if (NILP (buffer)) - return current_buffer->name; + return B_ (current_buffer, name); CHECK_BUFFER (buffer); - return XBUFFER (buffer)->name; + return B_ (XBUFFER (buffer), name); } DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, @@ -841,9 +841,9 @@ No argument or nil as argument means use the current buffer. */) (register Lisp_Object buffer) { if (NILP (buffer)) - return current_buffer->filename; + return B_ (current_buffer, filename); CHECK_BUFFER (buffer); - return XBUFFER (buffer)->filename; + return B_ (XBUFFER (buffer), filename); } DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, @@ -895,7 +895,7 @@ is the default binding of the variable. */) { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ - result = Fassoc (variable, buf->local_var_alist); + result = Fassoc (variable, B_ (buf, local_var_alist)); if (!NILP (result)) { if (blv->fwd) @@ -944,7 +944,7 @@ buffer_lisp_local_variables (struct buffer *buf) { Lisp_Object result = Qnil; register Lisp_Object tail; - for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) { Lisp_Object val, elt; @@ -1043,9 +1043,9 @@ A non-nil FLAG means mark the buffer modified. */) /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ - fn = current_buffer->file_truename; + fn = B_ (current_buffer, file_truename); /* Test buffer-file-name so that binding it to nil is effective. */ - if (!NILP (fn) && ! NILP (current_buffer->filename)) + if (!NILP (fn) && ! NILP (B_ (current_buffer, filename))) { already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) @@ -1110,9 +1110,9 @@ state of the current buffer. Use with care. */) /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ - fn = current_buffer->file_truename; + fn = B_ (current_buffer, file_truename); /* Test buffer-file-name so that binding it to nil is effective. */ - if (!NILP (fn) && ! NILP (current_buffer->filename)) + if (!NILP (fn) && ! NILP (B_ (current_buffer, filename))) { int already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) @@ -1199,14 +1199,14 @@ This does not change the name of the visited file (if any). */) with the original name. It makes UNIQUE equivalent to (rename-buffer (generate-new-buffer-name NEWNAME)). */ if (NILP (unique) && XBUFFER (tem) == current_buffer) - return current_buffer->name; + return B_ (current_buffer, name); if (!NILP (unique)) - newname = Fgenerate_new_buffer_name (newname, current_buffer->name); + newname = Fgenerate_new_buffer_name (newname, B_ (current_buffer, name)); else error ("Buffer name `%s' is in use", SDATA (newname)); } - current_buffer->name = newname; + B_ (current_buffer, name) = newname; /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ @@ -1214,11 +1214,11 @@ This does not change the name of the visited file (if any). */) XSETBUFFER (buf, current_buffer); Fsetcar (Frassq (buf, Vbuffer_alist), newname); - if (NILP (current_buffer->filename) - && !NILP (current_buffer->auto_save_file_name)) + if (NILP (B_ (current_buffer, filename)) + && !NILP (B_ (current_buffer, auto_save_file_name))) call0 (intern ("rename-auto-save-file")); /* Refetch since that last call may have done GC. */ - return current_buffer->name; + return B_ (current_buffer, name); } DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, @@ -1263,9 +1263,9 @@ If BUFFER is omitted or nil, some interesting buffer is returned. */) continue; if (NILP (buf)) continue; - if (NILP (XBUFFER (buf)->name)) + if (NILP (B_ (XBUFFER (buf), name))) continue; - if (SREF (XBUFFER (buf)->name, 0) == ' ') + if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') continue; /* If the selected frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ @@ -1313,8 +1313,8 @@ No argument or nil as argument means do this for the current buffer. */) nsberror (buffer); } - if (EQ (XBUFFER (real_buffer)->undo_list, Qt)) - XBUFFER (real_buffer)->undo_list = Qnil; + if (EQ (B_ (XBUFFER (real_buffer), undo_list), Qt)) + B_ (XBUFFER (real_buffer), undo_list) = Qnil; return Qnil; } @@ -1359,16 +1359,16 @@ with SIGHUP. */) b = XBUFFER (buffer); /* Avoid trouble for buffer already dead. */ - if (NILP (b->name)) + if (NILP (B_ (b, name))) return Qnil; /* Query if the buffer is still modified. */ - if (INTERACTIVE && !NILP (b->filename) + if (INTERACTIVE && !NILP (B_ (b, filename)) && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) { GCPRO1 (buffer); tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ", - b->name, make_number (0))); + B_ (b, name), make_number (0))); UNGCPRO; if (NILP (tem)) return Qnil; @@ -1402,7 +1402,7 @@ with SIGHUP. */) if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) return Qnil; - if (NILP (b->name)) + if (NILP (B_ (b, name))) return Qnil; /* When we kill a base buffer, kill all its indirect buffers. @@ -1417,7 +1417,7 @@ with SIGHUP. */) for (other = all_buffers; other; other = other->next) /* all_buffers contains dead buffers too; don't re-kill them. */ - if (other->base_buffer == b && !NILP (other->name)) + if (other->base_buffer == b && !NILP (B_ (other, name))) { Lisp_Object buffer; XSETBUFFER (buffer, other); @@ -1462,7 +1462,7 @@ with SIGHUP. */) /* Killing buffer processes may run sentinels which may have called kill-buffer. */ - if (NILP (b->name)) + if (NILP (B_ (b, name))) return Qnil; clear_charpos_cache (b); @@ -1476,7 +1476,7 @@ with SIGHUP. */) /* Delete any auto-save file, if we saved it in this session. But not if the buffer is modified. */ - if (STRINGP (b->auto_save_file_name) + if (STRINGP (B_ (b, auto_save_file_name)) && BUF_AUTOSAVE_MODIFF (b) != 0 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) @@ -1485,7 +1485,7 @@ with SIGHUP. */) Lisp_Object tem; tem = Fsymbol_value (intern ("delete-auto-save-files")); if (! NILP (tem)) - internal_delete_file (b->auto_save_file_name); + internal_delete_file (B_ (b, auto_save_file_name)); } if (b->base_buffer) @@ -1525,7 +1525,7 @@ with SIGHUP. */) swap_out_buffer_local_variables (b); reset_buffer_local_variables (b, 1); - b->name = Qnil; + B_ (b, name) = Qnil; BLOCK_INPUT; if (! b->base_buffer) @@ -1541,9 +1541,9 @@ with SIGHUP. */) free_region_cache (b->width_run_cache); b->width_run_cache = 0; } - b->width_table = Qnil; + B_ (b, width_table) = Qnil; UNBLOCK_INPUT; - b->undo_list = Qnil; + B_ (b, undo_list) = Qnil; return Qt; } @@ -1637,15 +1637,15 @@ the current buffer's major mode. */) CHECK_BUFFER (buffer); - if (STRINGP (XBUFFER (buffer)->name) - && strcmp (SSDATA (XBUFFER (buffer)->name), "*scratch*") == 0) + if (STRINGP (B_ (XBUFFER (buffer), name)) + && strcmp (SSDATA (B_ (XBUFFER (buffer), name)), "*scratch*") == 0) function = find_symbol_value (intern ("initial-major-mode")); else { - function = buffer_defaults.major_mode; + function = B_ (&buffer_defaults, major_mode); if (NILP (function) - && NILP (Fget (current_buffer->major_mode, Qmode_class))) - function = current_buffer->major_mode; + && NILP (Fget (B_ (current_buffer, major_mode), Qmode_class))) + function = B_ (current_buffer, major_mode); } if (NILP (function) || EQ (function, Qfundamental_mode)) @@ -1795,29 +1795,29 @@ set_buffer_internal_1 (register struct buffer *b) /* Put the undo list back in the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (old_buf->base_buffer) - old_buf->base_buffer->undo_list = old_buf->undo_list; + B_ (old_buf->base_buffer, undo_list) = B_ (old_buf, undo_list); /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ - if (! NILP (old_buf->pt_marker)) + if (! NILP (B_ (old_buf, pt_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->pt_marker, obuf, + set_marker_both (B_ (old_buf, pt_marker), obuf, BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); } - if (! NILP (old_buf->begv_marker)) + if (! NILP (B_ (old_buf, begv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->begv_marker, obuf, + set_marker_both (B_ (old_buf, begv_marker), obuf, BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); } - if (! NILP (old_buf->zv_marker)) + if (! NILP (B_ (old_buf, zv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->zv_marker, obuf, + set_marker_both (B_ (old_buf, zv_marker), obuf, BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); } } @@ -1825,24 +1825,24 @@ set_buffer_internal_1 (register struct buffer *b) /* Get the undo list from the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (b->base_buffer) - b->undo_list = b->base_buffer->undo_list; + B_ (b, undo_list) = B_ (b->base_buffer, undo_list); /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ - if (! NILP (b->pt_marker)) + if (! NILP (B_ (b, pt_marker))) { - BUF_PT (b) = marker_position (b->pt_marker); - BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker); + BUF_PT (b) = marker_position (B_ (b, pt_marker)); + BUF_PT_BYTE (b) = marker_byte_position (B_ (b, pt_marker)); } - if (! NILP (b->begv_marker)) + if (! NILP (B_ (b, begv_marker))) { - BUF_BEGV (b) = marker_position (b->begv_marker); - BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker); + BUF_BEGV (b) = marker_position (B_ (b, begv_marker)); + BUF_BEGV_BYTE (b) = marker_byte_position (B_ (b, begv_marker)); } - if (! NILP (b->zv_marker)) + if (! NILP (B_ (b, zv_marker))) { - BUF_ZV (b) = marker_position (b->zv_marker); - BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker); + BUF_ZV (b) = marker_position (B_ (b, zv_marker)); + BUF_ZV_BYTE (b) = marker_byte_position (B_ (b, zv_marker)); } /* Look down buffer's list of local Lisp variables @@ -1850,7 +1850,7 @@ set_buffer_internal_1 (register struct buffer *b) do { - for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = B_ (b, local_var_alist); CONSP (tail); tail = XCDR (tail)) { Lisp_Object var = XCAR (XCAR (tail)); struct Lisp_Symbol *sym = XSYMBOL (var); @@ -1883,45 +1883,45 @@ set_buffer_temp (struct buffer *b) { /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ - if (! NILP (old_buf->pt_marker)) + if (! NILP (B_ (old_buf, pt_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->pt_marker, obuf, + set_marker_both (B_ (old_buf, pt_marker), obuf, BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); } - if (! NILP (old_buf->begv_marker)) + if (! NILP (B_ (old_buf, begv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->begv_marker, obuf, + set_marker_both (B_ (old_buf, begv_marker), obuf, BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); } - if (! NILP (old_buf->zv_marker)) + if (! NILP (B_ (old_buf, zv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->zv_marker, obuf, + set_marker_both (B_ (old_buf, zv_marker), obuf, BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); } } /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ - if (! NILP (b->pt_marker)) + if (! NILP (B_ (b, pt_marker))) { - BUF_PT (b) = marker_position (b->pt_marker); - BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker); + BUF_PT (b) = marker_position (B_ (b, pt_marker)); + BUF_PT_BYTE (b) = marker_byte_position (B_ (b, pt_marker)); } - if (! NILP (b->begv_marker)) + if (! NILP (B_ (b, begv_marker))) { - BUF_BEGV (b) = marker_position (b->begv_marker); - BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker); + BUF_BEGV (b) = marker_position (B_ (b, begv_marker)); + BUF_BEGV_BYTE (b) = marker_byte_position (B_ (b, begv_marker)); } - if (! NILP (b->zv_marker)) + if (! NILP (B_ (b, zv_marker))) { - BUF_ZV (b) = marker_position (b->zv_marker); - BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker); + BUF_ZV (b) = marker_position (B_ (b, zv_marker)); + BUF_ZV_BYTE (b) = marker_byte_position (B_ (b, zv_marker)); } } @@ -1938,7 +1938,7 @@ ends when the current command terminates. Use `switch-to-buffer' or buffer = Fget_buffer (buffer_or_name); if (NILP (buffer)) nsberror (buffer_or_name); - if (NILP (XBUFFER (buffer)->name)) + if (NILP (B_ (XBUFFER (buffer), name))) error ("Selecting deleted buffer"); set_buffer_internal (XBUFFER (buffer)); return buffer; @@ -1949,7 +1949,7 @@ ends when the current command terminates. Use `switch-to-buffer' or Lisp_Object set_buffer_if_live (Lisp_Object buffer) { - if (! NILP (XBUFFER (buffer)->name)) + if (! NILP (B_ (XBUFFER (buffer), name))) Fset_buffer (buffer); return Qnil; } @@ -1959,7 +1959,7 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */) (void) { - if (!NILP (current_buffer->read_only) + if (!NILP (B_ (current_buffer, read_only)) && NILP (Vinhibit_read_only)) xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); return Qnil; @@ -2008,7 +2008,7 @@ its frame, iconify that frame. */) /* Move buffer to the end of the buffer list. Do nothing if the buffer is killed. */ - if (!NILP (XBUFFER (buffer)->name)) + if (!NILP (B_ (XBUFFER (buffer), name))) { Lisp_Object aelt, link; @@ -2041,7 +2041,7 @@ so the buffer is truly empty after this. */) /* Prevent warnings, or suspension of auto saving, that would happen if future size is less than past size. Use of erase-buffer implies that the future text is not really related to the past text. */ - XSETFASTINT (current_buffer->save_length, 0); + XSETFASTINT (B_ (current_buffer, save_length), 0); return Qnil; } @@ -2111,7 +2111,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, CHECK_BUFFER (buffer); other_buffer = XBUFFER (buffer); - if (NILP (other_buffer->name)) + if (NILP (B_ (other_buffer, name))) error ("Cannot swap a dead buffer's text"); /* Actually, it probably works just fine. @@ -2138,6 +2138,12 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, other_buffer->field = current_buffer->field; \ current_buffer->field = tmp##field; \ } while (0) +#define swapfield_(field, type) \ + do { \ + type tmp##field = B_ (other_buffer, field); \ + B_ (other_buffer, field) = B_ (current_buffer, field); \ + B_ (current_buffer, field) = tmp##field; \ + } while (0) swapfield (own_text, struct buffer_text); eassert (current_buffer->text == ¤t_buffer->own_text); @@ -2165,18 +2171,18 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, swapfield (overlays_before, struct Lisp_Overlay *); swapfield (overlays_after, struct Lisp_Overlay *); swapfield (overlay_center, EMACS_INT); - swapfield (undo_list, Lisp_Object); - swapfield (mark, Lisp_Object); - swapfield (enable_multibyte_characters, Lisp_Object); - swapfield (bidi_display_reordering, Lisp_Object); - swapfield (bidi_paragraph_direction, Lisp_Object); + swapfield_ (undo_list, Lisp_Object); + swapfield_ (mark, Lisp_Object); + swapfield_ (enable_multibyte_characters, Lisp_Object); + swapfield_ (bidi_display_reordering, Lisp_Object); + swapfield_ (bidi_paragraph_direction, Lisp_Object); /* FIXME: Not sure what we should do with these *_marker fields. Hopefully they're just nil anyway. */ - swapfield (pt_marker, Lisp_Object); - swapfield (begv_marker, Lisp_Object); - swapfield (zv_marker, Lisp_Object); - current_buffer->point_before_scroll = Qnil; - other_buffer->point_before_scroll = Qnil; + swapfield_ (pt_marker, Lisp_Object); + swapfield_ (begv_marker, Lisp_Object); + swapfield_ (zv_marker, Lisp_Object); + B_ (current_buffer, point_before_scroll) = Qnil; + B_ (other_buffer, point_before_scroll) = Qnil; current_buffer->text->modiff++; other_buffer->text->modiff++; current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++; @@ -2250,21 +2256,21 @@ current buffer is cleared. */) EMACS_INT begv, zv; int narrowed = (BEG != BEGV || Z != ZV); int modified_p = !NILP (Fbuffer_modified_p (Qnil)); - Lisp_Object old_undo = current_buffer->undo_list; + Lisp_Object old_undo = B_ (current_buffer, undo_list); struct gcpro gcpro1; if (current_buffer->base_buffer) error ("Cannot do `set-buffer-multibyte' on an indirect buffer"); /* Do nothing if nothing actually changes. */ - if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters)) + if (NILP (flag) == NILP (B_ (current_buffer, enable_multibyte_characters))) return flag; GCPRO1 (old_undo); /* Don't record these buffer changes. We will put a special undo entry instead. */ - current_buffer->undo_list = Qt; + B_ (current_buffer, undo_list) = Qt; /* If the cached position is for this buffer, clear it out. */ clear_charpos_cache (current_buffer); @@ -2286,7 +2292,7 @@ current buffer is cleared. */) to calculate the old correspondences. */ set_intervals_multibyte (0); - current_buffer->enable_multibyte_characters = Qnil; + B_ (current_buffer, enable_multibyte_characters) = Qnil; Z = Z_BYTE; BEGV = BEGV_BYTE; @@ -2424,7 +2430,7 @@ current buffer is cleared. */) /* Do this first, so that chars_in_text asks the right question. set_intervals_multibyte needs it too. */ - current_buffer->enable_multibyte_characters = Qt; + B_ (current_buffer, enable_multibyte_characters) = Qt; GPT_BYTE = advance_to_char_boundary (GPT_BYTE); GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG; @@ -2482,7 +2488,7 @@ current buffer is cleared. */) if (!EQ (old_undo, Qt)) { /* Represent all the above changes by a special undo entry. */ - current_buffer->undo_list = Fcons (list3 (Qapply, + B_ (current_buffer, undo_list) = Fcons (list3 (Qapply, intern ("set-buffer-multibyte"), NILP (flag) ? Qt : Qnil), old_undo); @@ -2498,10 +2504,10 @@ current buffer is cleared. */) /* Copy this buffer's new multibyte status into all of its indirect buffers. */ for (other = all_buffers; other; other = other->next) - if (other->base_buffer == current_buffer && !NILP (other->name)) + if (other->base_buffer == current_buffer && !NILP (B_ (other, name))) { - other->enable_multibyte_characters - = current_buffer->enable_multibyte_characters; + B_ (other, enable_multibyte_characters) + = B_ (current_buffer, enable_multibyte_characters); other->prevent_redisplay_optimizations_p = 1; } @@ -2568,7 +2574,7 @@ swap_out_buffer_local_variables (struct buffer *b) Lisp_Object oalist, alist, buffer; XSETBUFFER (buffer, b); - oalist = b->local_var_alist; + oalist = B_ (b, local_var_alist); for (alist = oalist; CONSP (alist); alist = XCDR (alist)) { @@ -3072,7 +3078,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); ssl->used++; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) nbytes = SCHARS (str); else if (! STRING_MULTIBYTE (str)) nbytes = count_size_as_multibyte (SDATA (str), @@ -3084,7 +3090,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str if (STRINGP (str2)) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) nbytes = SCHARS (str2); else if (! STRING_MULTIBYTE (str2)) nbytes = count_size_as_multibyte (SDATA (str2), @@ -3114,7 +3120,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr) Lisp_Object overlay, window, str; struct Lisp_Overlay *ov; EMACS_INT startpos, endpos; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); overlay_heads.used = overlay_heads.bytes = 0; overlay_tails.used = overlay_tails.bytes = 0; @@ -4985,9 +4991,9 @@ init_buffer_once (void) /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); - eassert (EQ (buffer_defaults.name, make_number (0))); + eassert (EQ (B_ (&buffer_defaults, name), make_number (0))); reset_buffer_local_variables (&buffer_defaults, 1); - eassert (EQ (buffer_local_symbols.name, make_number (0))); + eassert (EQ (B_ (&buffer_local_symbols, name), make_number (0))); reset_buffer (&buffer_local_symbols); reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ @@ -5004,60 +5010,60 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - buffer_defaults.mode_line_format = make_pure_c_string ("%-"); - buffer_defaults.header_line_format = Qnil; - buffer_defaults.abbrev_mode = Qnil; - buffer_defaults.overwrite_mode = Qnil; - buffer_defaults.case_fold_search = Qt; - buffer_defaults.auto_fill_function = Qnil; - buffer_defaults.selective_display = Qnil; + B_ (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); + B_ (&buffer_defaults, header_line_format) = Qnil; + B_ (&buffer_defaults, abbrev_mode) = Qnil; + B_ (&buffer_defaults, overwrite_mode) = Qnil; + B_ (&buffer_defaults, case_fold_search) = Qt; + B_ (&buffer_defaults, auto_fill_function) = Qnil; + B_ (&buffer_defaults, selective_display) = Qnil; #ifndef old - buffer_defaults.selective_display_ellipses = Qt; + B_ (&buffer_defaults, selective_display_ellipses) = Qt; #endif - buffer_defaults.abbrev_table = Qnil; - buffer_defaults.display_table = Qnil; - buffer_defaults.undo_list = Qnil; - buffer_defaults.mark_active = Qnil; - buffer_defaults.file_format = Qnil; - buffer_defaults.auto_save_file_format = Qt; + B_ (&buffer_defaults, abbrev_table) = Qnil; + B_ (&buffer_defaults, display_table) = Qnil; + B_ (&buffer_defaults, undo_list) = Qnil; + B_ (&buffer_defaults, mark_active) = Qnil; + B_ (&buffer_defaults, file_format) = Qnil; + B_ (&buffer_defaults, auto_save_file_format) = Qt; buffer_defaults.overlays_before = NULL; buffer_defaults.overlays_after = NULL; buffer_defaults.overlay_center = BEG; - XSETFASTINT (buffer_defaults.tab_width, 8); - buffer_defaults.truncate_lines = Qnil; - buffer_defaults.word_wrap = Qnil; - buffer_defaults.ctl_arrow = Qt; - buffer_defaults.bidi_display_reordering = Qnil; - buffer_defaults.bidi_paragraph_direction = Qnil; - buffer_defaults.cursor_type = Qt; - buffer_defaults.extra_line_spacing = Qnil; - buffer_defaults.cursor_in_non_selected_windows = Qt; + XSETFASTINT (B_ (&buffer_defaults, tab_width), 8); + B_ (&buffer_defaults, truncate_lines) = Qnil; + B_ (&buffer_defaults, word_wrap) = Qnil; + B_ (&buffer_defaults, ctl_arrow) = Qt; + B_ (&buffer_defaults, bidi_display_reordering) = Qnil; + B_ (&buffer_defaults, bidi_paragraph_direction) = Qnil; + B_ (&buffer_defaults, cursor_type) = Qt; + B_ (&buffer_defaults, extra_line_spacing) = Qnil; + B_ (&buffer_defaults, cursor_in_non_selected_windows) = Qt; #ifdef DOS_NT - buffer_defaults.buffer_file_type = Qnil; /* TEXT */ + B_ (&buffer_defaults, buffer_file_type) = Qnil; /* TEXT */ #endif - buffer_defaults.enable_multibyte_characters = Qt; - buffer_defaults.buffer_file_coding_system = Qnil; - XSETFASTINT (buffer_defaults.fill_column, 70); - XSETFASTINT (buffer_defaults.left_margin, 0); - buffer_defaults.cache_long_line_scans = Qnil; - buffer_defaults.file_truename = Qnil; - XSETFASTINT (buffer_defaults.display_count, 0); - XSETFASTINT (buffer_defaults.left_margin_cols, 0); - XSETFASTINT (buffer_defaults.right_margin_cols, 0); - buffer_defaults.left_fringe_width = Qnil; - buffer_defaults.right_fringe_width = Qnil; - buffer_defaults.fringes_outside_margins = Qnil; - buffer_defaults.scroll_bar_width = Qnil; - buffer_defaults.vertical_scroll_bar_type = Qt; - buffer_defaults.indicate_empty_lines = Qnil; - buffer_defaults.indicate_buffer_boundaries = Qnil; - buffer_defaults.fringe_indicator_alist = Qnil; - buffer_defaults.fringe_cursor_alist = Qnil; - buffer_defaults.scroll_up_aggressively = Qnil; - buffer_defaults.scroll_down_aggressively = Qnil; - buffer_defaults.display_time = Qnil; + B_ (&buffer_defaults, enable_multibyte_characters) = Qt; + B_ (&buffer_defaults, buffer_file_coding_system) = Qnil; + XSETFASTINT (B_ (&buffer_defaults, fill_column), 70); + XSETFASTINT (B_ (&buffer_defaults, left_margin), 0); + B_ (&buffer_defaults, cache_long_line_scans) = Qnil; + B_ (&buffer_defaults, file_truename) = Qnil; + XSETFASTINT (B_ (&buffer_defaults, display_count), 0); + XSETFASTINT (B_ (&buffer_defaults, left_margin_cols), 0); + XSETFASTINT (B_ (&buffer_defaults, right_margin_cols), 0); + B_ (&buffer_defaults, left_fringe_width) = Qnil; + B_ (&buffer_defaults, right_fringe_width) = Qnil; + B_ (&buffer_defaults, fringes_outside_margins) = Qnil; + B_ (&buffer_defaults, scroll_bar_width) = Qnil; + B_ (&buffer_defaults, vertical_scroll_bar_type) = Qt; + B_ (&buffer_defaults, indicate_empty_lines) = Qnil; + B_ (&buffer_defaults, indicate_buffer_boundaries) = Qnil; + B_ (&buffer_defaults, fringe_indicator_alist) = Qnil; + B_ (&buffer_defaults, fringe_cursor_alist) = Qnil; + B_ (&buffer_defaults, scroll_up_aggressively) = Qnil; + B_ (&buffer_defaults, scroll_down_aggressively) = Qnil; + B_ (&buffer_defaults, display_time) = Qnil; /* Assign the local-flags to the slots that have default values. The local flag is a bit that is used in the buffer @@ -5069,73 +5075,73 @@ init_buffer_once (void) /* 0 means not a lisp var, -1 means always local, else mask */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); - XSETINT (buffer_local_flags.filename, -1); - XSETINT (buffer_local_flags.directory, -1); - XSETINT (buffer_local_flags.backed_up, -1); - XSETINT (buffer_local_flags.save_length, -1); - XSETINT (buffer_local_flags.auto_save_file_name, -1); - XSETINT (buffer_local_flags.read_only, -1); - XSETINT (buffer_local_flags.major_mode, -1); - XSETINT (buffer_local_flags.mode_name, -1); - XSETINT (buffer_local_flags.undo_list, -1); - XSETINT (buffer_local_flags.mark_active, -1); - XSETINT (buffer_local_flags.point_before_scroll, -1); - XSETINT (buffer_local_flags.file_truename, -1); - XSETINT (buffer_local_flags.invisibility_spec, -1); - XSETINT (buffer_local_flags.file_format, -1); - XSETINT (buffer_local_flags.auto_save_file_format, -1); - XSETINT (buffer_local_flags.display_count, -1); - XSETINT (buffer_local_flags.display_time, -1); - XSETINT (buffer_local_flags.enable_multibyte_characters, -1); + XSETINT (B_ (&buffer_local_flags, filename), -1); + XSETINT (B_ (&buffer_local_flags, directory), -1); + XSETINT (B_ (&buffer_local_flags, backed_up), -1); + XSETINT (B_ (&buffer_local_flags, save_length), -1); + XSETINT (B_ (&buffer_local_flags, auto_save_file_name), -1); + XSETINT (B_ (&buffer_local_flags, read_only), -1); + XSETINT (B_ (&buffer_local_flags, major_mode), -1); + XSETINT (B_ (&buffer_local_flags, mode_name), -1); + XSETINT (B_ (&buffer_local_flags, undo_list), -1); + XSETINT (B_ (&buffer_local_flags, mark_active), -1); + XSETINT (B_ (&buffer_local_flags, point_before_scroll), -1); + XSETINT (B_ (&buffer_local_flags, file_truename), -1); + XSETINT (B_ (&buffer_local_flags, invisibility_spec), -1); + XSETINT (B_ (&buffer_local_flags, file_format), -1); + XSETINT (B_ (&buffer_local_flags, auto_save_file_format), -1); + XSETINT (B_ (&buffer_local_flags, display_count), -1); + XSETINT (B_ (&buffer_local_flags, display_time), -1); + XSETINT (B_ (&buffer_local_flags, enable_multibyte_characters), -1); idx = 1; - XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx; - XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx; - XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx; - XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx; - XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx; - XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, mode_line_format), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, abbrev_mode), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, overwrite_mode), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, case_fold_search), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, auto_fill_function), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, selective_display), idx); ++idx; #ifndef old - XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, selective_display_ellipses), idx); ++idx; #endif - XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx; - XSETFASTINT (buffer_local_flags.word_wrap, idx); ++idx; - XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx; - XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx; - XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx; - XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx; - XSETFASTINT (buffer_local_flags.display_table, idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, tab_width), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, truncate_lines), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, word_wrap), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, ctl_arrow), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, fill_column), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, left_margin), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, abbrev_table), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, display_table), idx); ++idx; #ifdef DOS_NT - XSETFASTINT (buffer_local_flags.buffer_file_type, idx); + XSETFASTINT (B_ (&buffer_local_flags, buffer_file_type), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; #endif - XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx; - XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx; - XSETFASTINT (buffer_local_flags.category_table, idx); ++idx; - XSETFASTINT (buffer_local_flags.bidi_display_reordering, idx); ++idx; - XSETFASTINT (buffer_local_flags.bidi_paragraph_direction, idx); ++idx; - XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx); + XSETFASTINT (B_ (&buffer_local_flags, syntax_table), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, cache_long_line_scans), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, category_table), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, bidi_display_reordering), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, buffer_file_coding_system), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; - XSETFASTINT (buffer_local_flags.left_margin_cols, idx); ++idx; - XSETFASTINT (buffer_local_flags.right_margin_cols, idx); ++idx; - XSETFASTINT (buffer_local_flags.left_fringe_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.right_fringe_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.fringes_outside_margins, idx); ++idx; - XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx; - XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx; - XSETFASTINT (buffer_local_flags.indicate_buffer_boundaries, idx); ++idx; - XSETFASTINT (buffer_local_flags.fringe_indicator_alist, idx); ++idx; - XSETFASTINT (buffer_local_flags.fringe_cursor_alist, idx); ++idx; - XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx; - XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx; - XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx; - XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx; - XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx; - XSETFASTINT (buffer_local_flags.cursor_in_non_selected_windows, idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, left_margin_cols), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, right_margin_cols), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, left_fringe_width), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, right_fringe_width), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, fringes_outside_margins), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, scroll_bar_width), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, indicate_empty_lines), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, header_line_format), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, cursor_type), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, extra_line_spacing), idx); ++idx; + XSETFASTINT (B_ (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; /* Need more room? */ if (idx >= MAX_PER_BUFFER_VARS) @@ -5149,7 +5155,7 @@ init_buffer_once (void) QSFundamental = make_pure_c_string ("Fundamental"); Qfundamental_mode = intern_c_string ("fundamental-mode"); - buffer_defaults.major_mode = Qfundamental_mode; + B_ (&buffer_defaults, major_mode) = Qfundamental_mode; Qmode_class = intern_c_string ("mode-class"); @@ -5192,7 +5198,7 @@ init_buffer (void) #endif /* USE_MMAP_FOR_BUFFERS */ Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); - if (NILP (buffer_defaults.enable_multibyte_characters)) + if (NILP (B_ (&buffer_defaults, enable_multibyte_characters))) Fset_buffer_multibyte (Qnil); pwd = get_current_dir_name (); @@ -5213,28 +5219,28 @@ init_buffer (void) pwd[len + 1] = '\0'; } - current_buffer->directory = make_unibyte_string (pwd, strlen (pwd)); - if (! NILP (buffer_defaults.enable_multibyte_characters)) + B_ (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); + if (! NILP (B_ (&buffer_defaults, enable_multibyte_characters))) /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in multibyte form so that ENCODE_FILE correctly gets the original bytes. */ - current_buffer->directory - = string_to_multibyte (current_buffer->directory); + B_ (current_buffer, directory) + = string_to_multibyte (B_ (current_buffer, directory)); /* Add /: to the front of the name if it would otherwise be treated as magic. */ - temp = Ffind_file_name_handler (current_buffer->directory, Qt); + temp = Ffind_file_name_handler (B_ (current_buffer, directory), Qt); if (! NILP (temp) /* If the default dir is just /, TEMP is non-nil because of the ange-ftp completion handler. However, it is not necessary to turn / into /:/. So avoid doing that. */ - && strcmp ("/", SSDATA (current_buffer->directory))) - current_buffer->directory - = concat2 (build_string ("/:"), current_buffer->directory); + && strcmp ("/", SSDATA (B_ (current_buffer, directory)))) + B_ (current_buffer, directory) + = concat2 (build_string ("/:"), B_ (current_buffer, directory)); temp = get_minibuffer (0); - XBUFFER (temp)->directory = current_buffer->directory; + B_ (XBUFFER (temp), directory) = B_ (current_buffer, directory); free (pwd); } @@ -5485,13 +5491,13 @@ This value applies in buffers that don't have their own local values. This is the same as (default-value 'scroll-down-aggressively). */); DEFVAR_PER_BUFFER ("header-line-format", - ¤t_buffer->header_line_format, + &B_ (current_buffer, header_line_format), Qnil, doc: /* Analogous to `mode-line-format', but controls the header line. The header line appears, optionally, at the top of a window; the mode line appears at the bottom. */); - DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format, + DEFVAR_PER_BUFFER ("mode-line-format", &B_ (current_buffer, mode_line_format), Qnil, doc: /* Template for displaying mode line for current buffer. Each buffer has its own value of this variable. @@ -5548,7 +5554,7 @@ Decimal digits after the % specify field width to which to pad. */); DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode, doc: /* *Value of `major-mode' for new buffers. */); - DEFVAR_PER_BUFFER ("major-mode", ¤t_buffer->major_mode, + DEFVAR_PER_BUFFER ("major-mode", &B_ (current_buffer, major_mode), make_number (Lisp_Symbol), doc: /* Symbol for current buffer's major mode. The default value (normally `fundamental-mode') affects new buffers. @@ -5561,46 +5567,46 @@ the buffer. Thus, the mode and its hooks should not expect certain variables such as `buffer-read-only' and `buffer-file-coding-system' to be set up. */); - DEFVAR_PER_BUFFER ("mode-name", ¤t_buffer->mode_name, + DEFVAR_PER_BUFFER ("mode-name", &B_ (current_buffer, mode_name), Qnil, doc: /* Pretty name of current buffer's major mode. Usually a string, but can use any of the constructs for `mode-line-format', which see. Format with `format-mode-line' to produce a string value. */); - DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer->abbrev_table, Qnil, + DEFVAR_PER_BUFFER ("local-abbrev-table", &B_ (current_buffer, abbrev_table), Qnil, doc: /* Local (mode-specific) abbrev table of current buffer. */); - DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer->abbrev_mode, Qnil, + DEFVAR_PER_BUFFER ("abbrev-mode", &B_ (current_buffer, abbrev_mode), Qnil, doc: /* Non-nil if Abbrev mode is enabled. Use the command `abbrev-mode' to change this variable. */); - DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer->case_fold_search, + DEFVAR_PER_BUFFER ("case-fold-search", &B_ (current_buffer, case_fold_search), Qnil, doc: /* *Non-nil if searches and matches should ignore case. */); - DEFVAR_PER_BUFFER ("fill-column", ¤t_buffer->fill_column, + DEFVAR_PER_BUFFER ("fill-column", &B_ (current_buffer, fill_column), make_number (LISP_INT_TAG), doc: /* *Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using \\[set-fill-column]. */); - DEFVAR_PER_BUFFER ("left-margin", ¤t_buffer->left_margin, + DEFVAR_PER_BUFFER ("left-margin", &B_ (current_buffer, left_margin), make_number (LISP_INT_TAG), doc: /* *Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode. */); - DEFVAR_PER_BUFFER ("tab-width", ¤t_buffer->tab_width, + DEFVAR_PER_BUFFER ("tab-width", &B_ (current_buffer, tab_width), make_number (LISP_INT_TAG), doc: /* *Distance between tab stops (for display of tab characters), in columns. */); - DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer->ctl_arrow, Qnil, + DEFVAR_PER_BUFFER ("ctl-arrow", &B_ (current_buffer, ctl_arrow), Qnil, doc: /* *Non-nil means display control chars with uparrow. A value of nil means use backslash and octal digits. This variable does not apply to characters whose display is specified in the current display table (if there is one). */); DEFVAR_PER_BUFFER ("enable-multibyte-characters", - ¤t_buffer->enable_multibyte_characters, + &B_ (current_buffer, enable_multibyte_characters), Qnil, doc: /* Non-nil means the buffer contents are regarded as multi-byte characters. Otherwise they are regarded as unibyte. This affects the display, @@ -5614,7 +5620,7 @@ See also variable `default-enable-multibyte-characters' and Info node XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; DEFVAR_PER_BUFFER ("buffer-file-coding-system", - ¤t_buffer->buffer_file_coding_system, Qnil, + &B_ (current_buffer, buffer_file_coding_system), Qnil, doc: /* Coding system to be used for encoding the buffer contents on saving. This variable applies to saving the buffer, and also to `write-region' and other functions that use `write-region'. @@ -5632,11 +5638,11 @@ The variable `coding-system-for-write', if non-nil, overrides this variable. This variable is never applied to a way of decoding a file while reading it. */); DEFVAR_PER_BUFFER ("bidi-display-reordering", - ¤t_buffer->bidi_display_reordering, Qnil, + &B_ (current_buffer, bidi_display_reordering), Qnil, doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); DEFVAR_PER_BUFFER ("bidi-paragraph-direction", - ¤t_buffer->bidi_paragraph_direction, Qnil, + &B_ (current_buffer, bidi_paragraph_direction), Qnil, doc: /* *If non-nil, forces directionality of text paragraphs in the buffer. If this is nil (the default), the direction of each paragraph is @@ -5647,7 +5653,7 @@ Any other value is treated as nil. This variable has no effect unless the buffer's value of \`bidi-display-reordering' is non-nil. */); - DEFVAR_PER_BUFFER ("truncate-lines", ¤t_buffer->truncate_lines, Qnil, + DEFVAR_PER_BUFFER ("truncate-lines", &B_ (current_buffer, truncate_lines), Qnil, doc: /* *Non-nil means do not display continuation lines. Instead, give each line of text just one screen line. @@ -5655,7 +5661,7 @@ Note that this is overridden by the variable `truncate-partial-width-windows' if that variable is non-nil and this buffer is not full-frame width. */); - DEFVAR_PER_BUFFER ("word-wrap", ¤t_buffer->word_wrap, Qnil, + DEFVAR_PER_BUFFER ("word-wrap", &B_ (current_buffer, word_wrap), Qnil, doc: /* *Non-nil means to use word-wrapping for continuation lines. When word-wrapping is on, continuation lines are wrapped at the space or tab character nearest to the right window edge. @@ -5668,7 +5674,7 @@ word-wrapping, you might want to reduce the value of in narrower windows. */); #ifdef DOS_NT - DEFVAR_PER_BUFFER ("buffer-file-type", ¤t_buffer->buffer_file_type, + DEFVAR_PER_BUFFER ("buffer-file-type", &B_ (current_buffer, buffer_file_type), Qnil, doc: /* Non-nil if the visited file is a binary file. This variable is meaningful on MS-DOG and Windows NT. @@ -5676,12 +5682,12 @@ On those systems, it is automatically local in every buffer. On other systems, this variable is normally always nil. */); #endif - DEFVAR_PER_BUFFER ("default-directory", ¤t_buffer->directory, + DEFVAR_PER_BUFFER ("default-directory", &B_ (current_buffer, directory), make_number (Lisp_String), doc: /* Name of default directory of current buffer. Should end with slash. To interactively change the default directory, use command `cd'. */); - DEFVAR_PER_BUFFER ("auto-fill-function", ¤t_buffer->auto_fill_function, + DEFVAR_PER_BUFFER ("auto-fill-function", &B_ (current_buffer, auto_fill_function), Qnil, doc: /* Function called (if non-nil) to perform auto-fill. It is called after self-inserting any character specified in @@ -5689,30 +5695,30 @@ the `auto-fill-chars' table. NOTE: This variable is not a hook; its value may not be a list of functions. */); - DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer->filename, + DEFVAR_PER_BUFFER ("buffer-file-name", &B_ (current_buffer, filename), make_number (Lisp_String), doc: /* Name of file visited in current buffer, or nil if not visiting a file. */); - DEFVAR_PER_BUFFER ("buffer-file-truename", ¤t_buffer->file_truename, + DEFVAR_PER_BUFFER ("buffer-file-truename", &B_ (current_buffer, file_truename), make_number (Lisp_String), doc: /* Abbreviated truename of file visited in current buffer, or nil if none. The truename of a file is calculated by `file-truename' and then abbreviated with `abbreviate-file-name'. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", - ¤t_buffer->auto_save_file_name, + &B_ (current_buffer, auto_save_file_name), make_number (Lisp_String), doc: /* Name of file for auto-saving current buffer. If it is nil, that means don't auto-save this buffer. */); - DEFVAR_PER_BUFFER ("buffer-read-only", ¤t_buffer->read_only, Qnil, + DEFVAR_PER_BUFFER ("buffer-read-only", &B_ (current_buffer, read_only), Qnil, doc: /* Non-nil if this buffer is read-only. */); - DEFVAR_PER_BUFFER ("buffer-backed-up", ¤t_buffer->backed_up, Qnil, + DEFVAR_PER_BUFFER ("buffer-backed-up", &B_ (current_buffer, backed_up), Qnil, doc: /* Non-nil if this buffer's file has been backed up. Backing up is done before the first time the file is saved. */); - DEFVAR_PER_BUFFER ("buffer-saved-size", ¤t_buffer->save_length, + DEFVAR_PER_BUFFER ("buffer-saved-size", &B_ (current_buffer, save_length), make_number (LISP_INT_TAG), doc: /* Length of current buffer when last read in, saved or auto-saved. 0 initially. @@ -5722,7 +5728,7 @@ If you set this to -2, that means don't turn off auto-saving in this buffer if its text size shrinks. If you use `buffer-swap-text' on a buffer, you probably should set this to -2 in that buffer. */); - DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer->selective_display, + DEFVAR_PER_BUFFER ("selective-display", &B_ (current_buffer, selective_display), Qnil, doc: /* Non-nil enables selective display. An integer N as value means display only lines @@ -5733,12 +5739,12 @@ in a file, save the ^M as a newline. */); #ifndef old DEFVAR_PER_BUFFER ("selective-display-ellipses", - ¤t_buffer->selective_display_ellipses, + &B_ (current_buffer, selective_display_ellipses), Qnil, doc: /* Non-nil means display ... on previous line when a line is invisible. */); #endif - DEFVAR_PER_BUFFER ("overwrite-mode", ¤t_buffer->overwrite_mode, Qnil, + DEFVAR_PER_BUFFER ("overwrite-mode", &B_ (current_buffer, overwrite_mode), Qnil, doc: /* Non-nil if self-insertion should replace existing text. The value should be one of `overwrite-mode-textual', `overwrite-mode-binary', or nil. @@ -5747,7 +5753,7 @@ inserts at the end of a line, and inserts when point is before a tab, until the tab is filled in. If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */); - DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer->display_table, + DEFVAR_PER_BUFFER ("buffer-display-table", &B_ (current_buffer, display_table), Qnil, doc: /* Display table that controls display of the contents of current buffer. @@ -5784,39 +5790,39 @@ In addition, a char-table has six extra slots to control the display of: See also the functions `display-table-slot' and `set-display-table-slot'. */); - DEFVAR_PER_BUFFER ("left-margin-width", ¤t_buffer->left_margin_cols, + DEFVAR_PER_BUFFER ("left-margin-width", &B_ (current_buffer, left_margin_cols), Qnil, doc: /* *Width of left marginal area for display of a buffer. A value of nil means no marginal area. */); - DEFVAR_PER_BUFFER ("right-margin-width", ¤t_buffer->right_margin_cols, + DEFVAR_PER_BUFFER ("right-margin-width", &B_ (current_buffer, right_margin_cols), Qnil, doc: /* *Width of right marginal area for display of a buffer. A value of nil means no marginal area. */); - DEFVAR_PER_BUFFER ("left-fringe-width", ¤t_buffer->left_fringe_width, + DEFVAR_PER_BUFFER ("left-fringe-width", &B_ (current_buffer, left_fringe_width), Qnil, doc: /* *Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame. */); - DEFVAR_PER_BUFFER ("right-fringe-width", ¤t_buffer->right_fringe_width, + DEFVAR_PER_BUFFER ("right-fringe-width", &B_ (current_buffer, right_fringe_width), Qnil, doc: /* *Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame. */); - DEFVAR_PER_BUFFER ("fringes-outside-margins", ¤t_buffer->fringes_outside_margins, + DEFVAR_PER_BUFFER ("fringes-outside-margins", &B_ (current_buffer, fringes_outside_margins), Qnil, doc: /* *Non-nil means to display fringes outside display margins. A value of nil means to display fringes between margins and buffer text. */); - DEFVAR_PER_BUFFER ("scroll-bar-width", ¤t_buffer->scroll_bar_width, + DEFVAR_PER_BUFFER ("scroll-bar-width", &B_ (current_buffer, scroll_bar_width), Qnil, doc: /* *Width of this buffer's scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame. */); - DEFVAR_PER_BUFFER ("vertical-scroll-bar", ¤t_buffer->vertical_scroll_bar_type, + DEFVAR_PER_BUFFER ("vertical-scroll-bar", &B_ (current_buffer, vertical_scroll_bar_type), Qnil, doc: /* *Position of this buffer's vertical scroll bar. The value takes effect whenever you tell a window to display this buffer; @@ -5827,13 +5833,13 @@ of the window; a value of nil means don't show any vertical scroll bars. A value of t (the default) means do whatever the window's frame specifies. */); DEFVAR_PER_BUFFER ("indicate-empty-lines", - ¤t_buffer->indicate_empty_lines, Qnil, + &B_ (current_buffer, indicate_empty_lines), Qnil, doc: /* *Visually indicate empty lines after the buffer end. If non-nil, a bitmap is displayed in the left fringe of a window on window-systems. */); DEFVAR_PER_BUFFER ("indicate-buffer-boundaries", - ¤t_buffer->indicate_buffer_boundaries, Qnil, + &B_ (current_buffer, indicate_buffer_boundaries), Qnil, doc: /* *Visually indicate buffer boundaries and scrolling. If non-nil, the first and last line of the buffer are marked in the fringe of a window on window-systems with angle bitmaps, or if the window can be @@ -5858,7 +5864,7 @@ bitmaps in right fringe. To show just the angle bitmaps in the left fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */); DEFVAR_PER_BUFFER ("fringe-indicator-alist", - ¤t_buffer->fringe_indicator_alist, Qnil, + &B_ (current_buffer, fringe_indicator_alist), Qnil, doc: /* *Mapping from logical to physical fringe indicator bitmaps. The value is an alist where each element (INDICATOR . BITMAPS) specifies the fringe bitmaps used to display a specific logical @@ -5877,7 +5883,7 @@ last (only) line has no final newline. BITMAPS may also be a single symbol which is used in both left and right fringes. */); DEFVAR_PER_BUFFER ("fringe-cursor-alist", - ¤t_buffer->fringe_cursor_alist, Qnil, + &B_ (current_buffer, fringe_cursor_alist), Qnil, doc: /* *Mapping from logical to physical fringe cursor bitmaps. The value is an alist where each element (CURSOR . BITMAP) specifies the fringe bitmaps used to display a specific logical @@ -5892,7 +5898,7 @@ BITMAP is the corresponding fringe bitmap shown for the logical cursor type. */); DEFVAR_PER_BUFFER ("scroll-up-aggressively", - ¤t_buffer->scroll_up_aggressively, Qnil, + &B_ (current_buffer, scroll_up_aggressively), Qnil, doc: /* How far to scroll windows upward. If you move point off the bottom, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -5905,7 +5911,7 @@ window scrolls by a full window height. Meaningful values are between 0.0 and 1.0, inclusive. */); DEFVAR_PER_BUFFER ("scroll-down-aggressively", - ¤t_buffer->scroll_down_aggressively, Qnil, + &B_ (current_buffer, scroll_down_aggressively), Qnil, doc: /* How far to scroll windows downward. If you move point off the top, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -5960,7 +5966,7 @@ from happening repeatedly and making Emacs nonfunctional. */); The functions are run using the `run-hooks' function. */); Vfirst_change_hook = Qnil; - DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer->undo_list, Qnil, + DEFVAR_PER_BUFFER ("buffer-undo-list", &B_ (current_buffer, undo_list), Qnil, doc: /* List of undo entries in current buffer. Recent changes come first; older changes follow newer. @@ -6001,10 +6007,10 @@ the changes between two undo boundaries as a single step to be undone. If the value of the variable is t, undo information is not recorded. */); - DEFVAR_PER_BUFFER ("mark-active", ¤t_buffer->mark_active, Qnil, + DEFVAR_PER_BUFFER ("mark-active", &B_ (current_buffer, mark_active), Qnil, doc: /* Non-nil means the mark and region are currently active in this buffer. */); - DEFVAR_PER_BUFFER ("cache-long-line-scans", ¤t_buffer->cache_long_line_scans, Qnil, + DEFVAR_PER_BUFFER ("cache-long-line-scans", &B_ (current_buffer, cache_long_line_scans), Qnil, doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly. Normally, the line-motion functions work by scanning the buffer for @@ -6032,23 +6038,23 @@ maintained internally by the Emacs primitives. Enabling or disabling the cache should not affect the behavior of any of the motion functions; it should only affect their performance. */); - DEFVAR_PER_BUFFER ("point-before-scroll", ¤t_buffer->point_before_scroll, Qnil, + DEFVAR_PER_BUFFER ("point-before-scroll", &B_ (current_buffer, point_before_scroll), Qnil, doc: /* Value of point before the last series of scroll operations, or nil. */); - DEFVAR_PER_BUFFER ("buffer-file-format", ¤t_buffer->file_format, Qnil, + DEFVAR_PER_BUFFER ("buffer-file-format", &B_ (current_buffer, file_format), Qnil, doc: /* List of formats to use when saving this buffer. Formats are defined by `format-alist'. This variable is set when a file is visited. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-format", - ¤t_buffer->auto_save_file_format, Qnil, + &B_ (current_buffer, auto_save_file_format), Qnil, doc: /* *Format in which to write auto-save files. Should be a list of symbols naming formats that are defined in `format-alist'. If it is t, which is the default, auto-save files are written in the same format as a regular save would use. */); DEFVAR_PER_BUFFER ("buffer-invisibility-spec", - ¤t_buffer->invisibility_spec, Qnil, + &B_ (current_buffer, invisibility_spec), Qnil, doc: /* Invisibility spec of this buffer. The default is t, which means that text is invisible if it has a non-nil `invisible' property. @@ -6059,12 +6065,12 @@ then characters with property value PROP are invisible, and they have an ellipsis as well if ELLIPSIS is non-nil. */); DEFVAR_PER_BUFFER ("buffer-display-count", - ¤t_buffer->display_count, Qnil, + &B_ (current_buffer, display_count), Qnil, doc: /* A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it. */); DEFVAR_PER_BUFFER ("buffer-display-time", - ¤t_buffer->display_time, Qnil, + &B_ (current_buffer, display_time), Qnil, doc: /* Time stamp updated each time this buffer is displayed in a window. The function `set-window-buffer' updates this variable to the value obtained by calling `current-time'. @@ -6099,7 +6105,7 @@ and disregard a `read-only' text property if the property value is a member of the list. */); Vinhibit_read_only = Qnil; - DEFVAR_PER_BUFFER ("cursor-type", ¤t_buffer->cursor_type, Qnil, + DEFVAR_PER_BUFFER ("cursor-type", &B_ (current_buffer, cursor_type), Qnil, doc: /* Cursor to use when this buffer is in the selected window. Values are interpreted as follows: @@ -6118,7 +6124,7 @@ cursor's appearance is instead controlled by the variable `cursor-in-non-selected-windows'. */); DEFVAR_PER_BUFFER ("line-spacing", - ¤t_buffer->extra_line_spacing, Qnil, + &B_ (current_buffer, extra_line_spacing), Qnil, doc: /* Additional space to put between lines when displaying a buffer. The space is measured in pixels, and put below lines on graphic displays, see `display-graphic-p'. @@ -6126,7 +6132,7 @@ If value is a floating point number, it specifies the spacing relative to the default frame line height. A value of nil means add no extra space. */); DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", - ¤t_buffer->cursor_in_non_selected_windows, Qnil, + &B_ (current_buffer, cursor_in_non_selected_windows), Qnil, doc: /* *Non-nil means show a cursor in non-selected windows. If nil, only shows a cursor in the selected window. If t, displays a cursor related to the usual cursor type diff --git a/src/buffer.h b/src/buffer.h index 31f96040b2d..36cb5fe9dda 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -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 diff --git a/src/bytecode.c b/src/bytecode.c index fd2680e4054..a470eca16a9 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -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)]); } diff --git a/src/callint.c b/src/callint.c index 2e4314295ff..154659490b8 100644 --- a/src/callint.c +++ b/src/callint.c @@ -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; diff --git a/src/callproc.c b/src/callproc.c index 27e8493bcf1..bdd3060bef1 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -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 { diff --git a/src/casefiddle.c b/src/casefiddle.c index 62d261278ab..6c05aecffe8 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -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); diff --git a/src/casetab.c b/src/casetab.c index 0db9d63f7a6..85c2d6e1581 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -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; diff --git a/src/category.c b/src/category.c index 06046959b6f..bf8269ffd75 100644 --- a/src/category.c +++ b/src/category.c @@ -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, diff --git a/src/category.h b/src/category.h index 561b06b6f60..16b31da0819 100644 --- a/src/category.h +++ b/src/category.h @@ -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) diff --git a/src/character.c b/src/character.c index 397481e5b39..e4ff3d7922c 100644 --- a/src/character.c +++ b/src/character.c @@ -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 diff --git a/src/character.h b/src/character.h index f2ccb28bb37..f2d06102f62 100644 --- a/src/character.h +++ b/src/character.h @@ -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 diff --git a/src/charset.c b/src/charset.c index 229f2c2cdae..80e6a114197 100644 --- a/src/charset.c +++ b/src/charset.c @@ -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); diff --git a/src/cmds.c b/src/cmds.c index 93b7e2b7651..e82ada6f03c 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -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); diff --git a/src/coding.c b/src/coding.c index a9f16de56f3..899cca6d5aa 100644 --- a/src/coding.c +++ b/src/coding.c @@ -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)); diff --git a/src/composite.c b/src/composite.c index 58bc68597cc..3c941ea6614 100644 --- a/src/composite.c +++ b/src/composite.c @@ -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)) diff --git a/src/data.c b/src/data.c index 77cdbabb2d5..c0557d5c735 100644 --- a/src/data.c +++ b/src/data.c @@ -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))) diff --git a/src/dired.c b/src/dired.c index e37055258d6..f1dc03b56d0 100644 --- a/src/dired.c +++ b/src/dired.c @@ -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 */ diff --git a/src/dispextern.h b/src/dispextern.h index 6d54ebefd84..e01c1a961f7 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -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 diff --git a/src/dispnew.c b/src/dispnew.c index 1aef70f1a5d..2aa3d9208b3 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -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). */ diff --git a/src/editfns.c b/src/editfns.c index 30acc36f025..a3de4907efc 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -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); diff --git a/src/fileio.c b/src/fileio.c index 429fce9f5a0..4a4935b43a2 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -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; } diff --git a/src/filelock.c b/src/filelock.c index 8fa871f56ef..6802880c985 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -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, diff --git a/src/fns.c b/src/fns.c index e7f0bcc1218..a9632914d67 100644 --- a/src/fns.c +++ b/src/fns.c @@ -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 diff --git a/src/font.c b/src/font.c index 841125a0587..d67e8465b6a 100644 --- a/src/font.c +++ b/src/font.c @@ -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) { diff --git a/src/frame.c b/src/frame.c index 20bad4cb8c5..ac223ac4da0 100644 --- a/src/frame.c +++ b/src/frame.c @@ -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); diff --git a/src/fringe.c b/src/fringe.c index 5c9088a924c..5b7f8833069 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -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; diff --git a/src/gtkutil.c b/src/gtkutil.c index 6367949a649..6ecd5d624af 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -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; diff --git a/src/indent.c b/src/indent.c index 84ce140c5ba..b0195b3dec8 100644 --- a/src/indent.c +++ b/src/indent.c @@ -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; diff --git a/src/insdel.c b/src/insdel.c index db76f770dad..db997fc938e 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -78,7 +78,7 @@ void check_markers (void) { register struct Lisp_Marker *tail; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) { @@ -703,7 +703,7 @@ insert_char (int c) 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 (c, str); else { @@ -891,7 +891,7 @@ insert_1_both (const char *string, if (nchars == 0) return; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) nchars = nbytes; if (prepare) @@ -1011,7 +1011,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) outgoing_nbytes = nchars; else if (! STRING_MULTIBYTE (string)) outgoing_nbytes @@ -1034,7 +1034,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, between single-byte and multibyte. */ copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes, STRING_MULTIBYTE (string), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (B_ (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not altered @@ -1094,7 +1094,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, void insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) nchars = nbytes; record_insert (GPT, nchars); @@ -1162,9 +1162,9 @@ insert_from_buffer_1 (struct buffer *buf, /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) outgoing_nbytes = nchars; - else if (NILP (buf->enable_multibyte_characters)) + else if (NILP (B_ (buf, enable_multibyte_characters))) { EMACS_INT outgoing_before_gap = 0; EMACS_INT outgoing_after_gap = 0; @@ -1215,8 +1215,8 @@ insert_from_buffer_1 (struct buffer *buf, chunk_expanded = copy_text (BUF_BYTE_ADDRESS (buf, from_byte), GPT_ADDR, chunk, - ! NILP (buf->enable_multibyte_characters), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (B_ (buf, enable_multibyte_characters)), + ! NILP (B_ (current_buffer, enable_multibyte_characters))); } else chunk_expanded = chunk = 0; @@ -1224,8 +1224,8 @@ insert_from_buffer_1 (struct buffer *buf, if (chunk < incoming_nbytes) copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk), GPT_ADDR + chunk_expanded, incoming_nbytes - chunk, - ! NILP (buf->enable_multibyte_characters), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (B_ (buf, enable_multibyte_characters)), + ! NILP (B_ (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not altered @@ -1320,7 +1320,7 @@ adjust_after_replace (EMACS_INT from, EMACS_INT from_byte, adjust_markers_for_insert (from, from_byte, from + len, from_byte + len_byte, 0); - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (B_ (current_buffer, undo_list), Qt)) { if (nchars_del > 0) record_delete (from, prev_text); @@ -1481,7 +1481,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, /* Make OUTGOING_INSBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) outgoing_insbytes = inschars; else if (! STRING_MULTIBYTE (new)) outgoing_insbytes @@ -1503,7 +1503,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, /* Even if we don't record for undo, we must keep the original text because we may have to recover it because of inappropriate byte combining. */ - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (B_ (current_buffer, undo_list), Qt)) deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); GAP_SIZE += nbytes_del; @@ -1530,7 +1530,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, between single-byte and multibyte. */ copy_text (SDATA (new), GPT_ADDR, insbytes, STRING_MULTIBYTE (new), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (B_ (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not marked @@ -1543,7 +1543,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, abort (); #endif - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (B_ (current_buffer, undo_list), Qt)) { /* Record the insertion first, so that when we undo, the deletion will be undone first. Thus, undo @@ -1886,7 +1886,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte, abort (); #endif - if (ret_string || ! EQ (current_buffer->undo_list, Qt)) + if (ret_string || ! EQ (B_ (current_buffer, undo_list), Qt)) deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); else deletion = Qnil; @@ -1897,7 +1897,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte, so that undo handles this after reinserting the text. */ adjust_markers_for_delete (from, from_byte, to, to_byte); - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (B_ (current_buffer, undo_list), Qt)) record_delete (from, deletion); MODIFF++; CHARS_MODIFF = MODIFF; @@ -1968,7 +1968,7 @@ modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end, if (! preserve_chars_modiff) CHARS_MODIFF = MODIFF; - buffer->point_before_scroll = Qnil; + B_ (buffer, point_before_scroll) = Qnil; if (buffer != old_buffer) set_buffer_internal (old_buffer); @@ -1990,7 +1990,7 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, { struct buffer *base_buffer; - if (!NILP (current_buffer->read_only)) + if (!NILP (B_ (current_buffer, read_only))) Fbarf_if_buffer_read_only (); /* Let redisplay consider other windows than selected_window @@ -2022,32 +2022,32 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, base_buffer = current_buffer; #ifdef CLASH_DETECTION - if (!NILP (base_buffer->file_truename) + if (!NILP (B_ (base_buffer, file_truename)) /* Make binding buffer-file-name to nil effective. */ - && !NILP (base_buffer->filename) + && !NILP (B_ (base_buffer, filename)) && SAVE_MODIFF >= MODIFF) - lock_file (base_buffer->file_truename); + lock_file (B_ (base_buffer, file_truename)); #else /* At least warn if this file has changed on disk since it was visited. */ - if (!NILP (base_buffer->filename) + if (!NILP (B_ (base_buffer, filename)) && SAVE_MODIFF >= MODIFF && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) - && !NILP (Ffile_exists_p (base_buffer->filename))) + && !NILP (Ffile_exists_p (B_ (base_buffer, filename)))) call1 (intern ("ask-user-about-supersession-threat"), - base_buffer->filename); + B_ (base_buffer,filename)); #endif /* not CLASH_DETECTION */ /* If `select-active-regions' is non-nil, save the region text. */ - if (!NILP (current_buffer->mark_active) + if (!NILP (B_ (current_buffer, mark_active)) && !inhibit_modification_hooks - && XMARKER (current_buffer->mark)->buffer + && XMARKER (B_ (current_buffer, mark))->buffer && NILP (Vsaved_region_selection) && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) && !NILP (Vtransient_mark_mode)))) { - EMACS_INT b = XMARKER (current_buffer->mark)->charpos; + EMACS_INT b = XMARKER (B_ (current_buffer, mark))->charpos; EMACS_INT e = PT; if (b < e) Vsaved_region_selection = make_buffer_string (b, e, 0); @@ -2290,7 +2290,7 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, non-nil, and insertion calls a file handler (e.g. through lock_file) which scribbles into a temp file -- cyd */ if (!BUFFERP (combine_after_change_buffer) - || NILP (XBUFFER (combine_after_change_buffer)->name)) + || NILP (B_ (XBUFFER (combine_after_change_buffer), name))) { combine_after_change_list = Qnil; return Qnil; diff --git a/src/intervals.c b/src/intervals.c index ad46c17d588..de5faf6ce75 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1978,7 +1978,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos) int have_overlays; EMACS_INT original_position; - current_buffer->point_before_scroll = Qnil; + B_ (current_buffer, point_before_scroll) = Qnil; if (charpos == PT) return; @@ -2342,7 +2342,7 @@ get_local_map (register EMACS_INT position, register struct buffer *buffer, if (EQ (type, Qkeymap)) return Qnil; else - return buffer->keymap; + return B_ (buffer, keymap); } /* Produce an interval tree reflecting the intervals in diff --git a/src/intervals.h b/src/intervals.h index 0762c9d8dc3..3c46c50db79 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -236,9 +236,9 @@ struct interval and 2 if it is invisible but with an ellipsis. */ #define TEXT_PROP_MEANS_INVISIBLE(prop) \ - (EQ (current_buffer->invisibility_spec, Qt) \ + (EQ (B_ (current_buffer, invisibility_spec), Qt) \ ? !NILP (prop) \ - : invisible_p (prop, current_buffer->invisibility_spec)) + : invisible_p (prop, B_ (current_buffer, invisibility_spec))) /* Declared in alloc.c */ diff --git a/src/keyboard.c b/src/keyboard.c index 71d6456e57c..339d32a838a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1577,7 +1577,7 @@ command_loop_1 (void) this_single_command_key_start = 0; } - if (!NILP (current_buffer->mark_active) + if (!NILP (B_ (current_buffer, mark_active)) && !NILP (Vrun_hooks)) { /* In Emacs 22, setting transient-mark-mode to `only' was a @@ -1599,7 +1599,7 @@ command_loop_1 (void) if (!NILP (Fwindow_system (Qnil)) /* Even if mark_active is non-nil, the actual buffer marker may not have been set yet (Bug#7044). */ - && XMARKER (current_buffer->mark)->buffer + && XMARKER (B_ (current_buffer, mark))->buffer && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) @@ -1607,7 +1607,7 @@ command_loop_1 (void) && !EQ (Vthis_command, Qhandle_switch_frame)) { EMACS_INT beg = - XINT (Fmarker_position (current_buffer->mark)); + XINT (Fmarker_position (B_ (current_buffer, mark))); EMACS_INT end = PT; if (beg < end) call2 (Qx_set_selection, QPRIMARY, @@ -8608,7 +8608,7 @@ read_char_minibuf_menu_prompt (int commandflag, int nmaps, Lisp_Object *maps) /* Prompt with that and read response. */ message2_nolog (menu, strlen (menu), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (B_ (current_buffer, enable_multibyte_characters))); /* Make believe its not a keyboard macro in case the help char is pressed. Help characters are not recorded because menu prompting @@ -9870,7 +9870,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, /* Treat uppercase keys as shifted. */ || (INTEGERP (key) && (KEY_TO_CHAR (key) - < XCHAR_TABLE (current_buffer->downcase_table)->size) + < XCHAR_TABLE (B_ (current_buffer, downcase_table))->size) && UPPERCASEP (KEY_TO_CHAR (key)))) { Lisp_Object new_key diff --git a/src/keyboard.h b/src/keyboard.h index 166b3c0e9d4..7b3374ac3bd 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -19,8 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "systime.h" /* for EMACS_TIME */ #include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */ -/* Length of echobuf field in each KBOARD. */ - /* Each KBOARD represents one logical input stream from which Emacs gets input. If we are using ordinary terminals, it has one KBOARD object for each terminal device. diff --git a/src/keymap.c b/src/keymap.c index 8ee4f41bd6f..b694deadcba 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1883,7 +1883,7 @@ bindings; see the description of `lookup-key' for more details about this. */) (Lisp_Object keys, Lisp_Object accept_default) { register Lisp_Object map; - map = current_buffer->keymap; + map = B_ (current_buffer, keymap); if (NILP (map)) return Qnil; return Flookup_key (map, keys, accept_default); @@ -1988,7 +1988,7 @@ If KEYMAP is nil, that means no local keymap. */) if (!NILP (keymap)) keymap = get_keymap (keymap, 1, 1); - current_buffer->keymap = keymap; + B_ (current_buffer, keymap) = keymap; return Qnil; } @@ -1998,7 +1998,7 @@ DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, Normally the local keymap is set by the major mode with `use-local-map'. */) (void) { - return current_buffer->keymap; + return B_ (current_buffer, keymap); } DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, @@ -2379,7 +2379,7 @@ push_key_description (register unsigned int c, register char *p, int force_multi *p++ = 'C'; } else if (c < 128 - || (NILP (current_buffer->enable_multibyte_characters) + || (NILP (B_ (current_buffer, enable_multibyte_characters)) && SINGLE_BYTE_CHAR_P (c) && !force_multibyte)) { @@ -2388,7 +2388,7 @@ push_key_description (register unsigned int c, register char *p, int force_multi else { /* Now we are sure that C is a valid character code. */ - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (B_ (current_buffer, enable_multibyte_characters)) && ! force_multibyte) *p++ = multibyte_char_to_unibyte (c, Qnil); else @@ -3048,7 +3048,7 @@ You type Translation\n\ XBUFFER (buffer), Qlocal_map); if (!NILP (start1)) { - if (EQ (start1, XBUFFER (buffer)->keymap)) + if (EQ (start1, B_ (XBUFFER (buffer), keymap))) describe_map_tree (start1, 1, shadow, prefix, "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); else diff --git a/src/lisp.h b/src/lisp.h index 2b2f61bbda4..0efadd675b0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1882,7 +1882,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \ do { \ static struct Lisp_Objfwd o_fwd; \ - defvar_lisp_nopro (&o_fwd, lname, &buffer_defaults.vname); \ + defvar_lisp_nopro (&o_fwd, lname, &buffer_defaults.vname ## _); \ } while (0) #define DEFVAR_KBOARD(lname, vname, doc) \ @@ -2047,11 +2047,11 @@ extern Lisp_Object case_temp2; /* Current buffer's map from characters to lower-case characters. */ -#define DOWNCASE_TABLE current_buffer->downcase_table +#define DOWNCASE_TABLE B_ (current_buffer, downcase_table) /* Current buffer's map from characters to upper-case characters. */ -#define UPCASE_TABLE current_buffer->upcase_table +#define UPCASE_TABLE B_ (current_buffer, upcase_table) /* Downcase a character, or make no change if that cannot be done. */ diff --git a/src/lread.c b/src/lread.c index f638aba211b..de9c5db95ad 100644 --- a/src/lread.c +++ b/src/lread.c @@ -210,7 +210,7 @@ readchar (Lisp_Object readcharfun, int *multibyte) if (pt_byte >= BUF_ZV_BYTE (inbuffer)) return -1; - if (! NILP (inbuffer->enable_multibyte_characters)) + if (! NILP (B_ (inbuffer, enable_multibyte_characters))) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); @@ -239,7 +239,7 @@ readchar (Lisp_Object readcharfun, int *multibyte) if (bytepos >= BUF_ZV_BYTE (inbuffer)) return -1; - if (! NILP (inbuffer->enable_multibyte_characters)) + if (! NILP (B_ (inbuffer, enable_multibyte_characters))) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); @@ -371,7 +371,7 @@ unreadchar (Lisp_Object readcharfun, int c) EMACS_INT bytepos = BUF_PT_BYTE (b); BUF_PT (b)--; - if (! NILP (b->enable_multibyte_characters)) + if (! NILP (B_ (b, enable_multibyte_characters))) BUF_DEC_POS (b, bytepos); else bytepos--; @@ -384,7 +384,7 @@ unreadchar (Lisp_Object readcharfun, int c) EMACS_INT bytepos = XMARKER (readcharfun)->bytepos; XMARKER (readcharfun)->charpos--; - if (! NILP (b->enable_multibyte_characters)) + if (! NILP (B_ (b, enable_multibyte_characters))) BUF_DEC_POS (b, bytepos); else bytepos--; @@ -1322,7 +1322,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto /* Of course, this could conceivably lose if luser sets default-directory to be something non-absolute... */ { - filename = Fexpand_file_name (filename, current_buffer->directory); + filename = Fexpand_file_name (filename, B_ (current_buffer, directory)); if (!complete_filename_p (filename)) /* Give up on this path element! */ continue; @@ -1581,7 +1581,7 @@ readevalloop (Lisp_Object readcharfun, { int count1 = SPECPDL_INDEX (); - if (b != 0 && NILP (b->name)) + if (b != 0 && NILP (B_ (b, name))) error ("Reading from killed buffer"); if (!NILP (start)) @@ -1721,7 +1721,7 @@ This function preserves the position of point. */) tem = printflag; if (NILP (filename)) - filename = XBUFFER (buf)->filename; + filename = B_ (XBUFFER (buf), filename); specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); @@ -1761,7 +1761,7 @@ This function does not move point. */) specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); /* readevalloop calls functions which check the type of start and end. */ - readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, + readevalloop (cbuf, 0, B_ (XBUFFER (cbuf), filename), Feval, !NILP (printflag), Qnil, read_function, start, end); diff --git a/src/marker.c b/src/marker.c index 1e0e1404fdb..9b841835646 100644 --- a/src/marker.c +++ b/src/marker.c @@ -439,7 +439,7 @@ Returns nil if MARKER points into a dead buffer. */) does not preserve the buffer from being GC'd (it's weak), so markers have to be unlinked from their buffer as soon as the buffer is killed. */ - eassert (!NILP (XBUFFER (buf)->name)); + eassert (!NILP (B_ (XBUFFER (buf), name))); return buf; } return Qnil; @@ -488,7 +488,7 @@ Returns MARKER. */) CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (B_ (b, name), Qnil)) { unchain_marker (m); return marker; @@ -563,7 +563,7 @@ set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer) CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (B_ (b, name), Qnil)) { unchain_marker (m); return marker; @@ -628,7 +628,7 @@ set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMAC CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (B_ (b, name), Qnil)) { unchain_marker (m); return marker; @@ -676,7 +676,7 @@ set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT ch CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (B_ (b, name), Qnil)) { unchain_marker (m); return marker; @@ -731,7 +731,7 @@ unchain_marker (register struct Lisp_Marker *marker) if (b == 0) return; - if (EQ (b->name, Qnil)) + if (EQ (B_ (b, name), Qnil)) abort (); marker->buffer = 0; diff --git a/src/minibuf.c b/src/minibuf.c index ec243daac19..3ed8630c845 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -415,7 +415,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, CHECK_STRING (initial); } val = Qnil; - ambient_dir = current_buffer->directory; + ambient_dir = B_ (current_buffer, directory); input_method = Qnil; enable_multibyte = Qnil; @@ -525,7 +525,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* `current-input-method' is buffer local. So, remember it in INPUT_METHOD before changing the current buffer. */ input_method = Fsymbol_value (Qcurrent_input_method); - enable_multibyte = current_buffer->enable_multibyte_characters; + enable_multibyte = B_ (current_buffer, enable_multibyte_characters); } /* Switch to the minibuffer. */ @@ -535,7 +535,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ if (inherit_input_method) - current_buffer->enable_multibyte_characters = enable_multibyte; + B_ (current_buffer, enable_multibyte_characters) = enable_multibyte; /* The current buffer's default directory is usually the right thing for our minibuffer here. However, if you're typing a command at @@ -546,7 +546,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, you think of something better to do? Find another buffer with a better directory, and use that one instead. */ if (STRINGP (ambient_dir)) - current_buffer->directory = ambient_dir; + B_ (current_buffer, directory) = ambient_dir; else { Lisp_Object buf_list; @@ -558,9 +558,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object other_buf; other_buf = XCDR (XCAR (buf_list)); - if (STRINGP (XBUFFER (other_buf)->directory)) + if (STRINGP (B_ (XBUFFER (other_buf), directory))) { - current_buffer->directory = XBUFFER (other_buf)->directory; + B_ (current_buffer, directory) = B_ (XBUFFER (other_buf), directory); break; } } @@ -603,7 +603,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); - if (!NILP (current_buffer->enable_multibyte_characters) + if (!NILP (B_ (current_buffer, enable_multibyte_characters)) && ! STRING_MULTIBYTE (minibuf_prompt)) minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); @@ -633,7 +633,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, } clear_message (1, 1); - current_buffer->keymap = map; + B_ (current_buffer, keymap) = map; /* Turn on an input method stored in INPUT_METHOD if any. */ if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) @@ -647,7 +647,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, call1 (Vrun_hooks, Qminibuffer_setup_hook); /* Don't allow the user to undo past this point. */ - current_buffer->undo_list = Qnil; + B_ (current_buffer, undo_list) = Qnil; recursive_edit_1 (); @@ -764,7 +764,7 @@ get_minibuffer (int depth) Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } buf = Fcar (tail); - if (NILP (buf) || NILP (XBUFFER (buf)->name)) + if (NILP (buf) || NILP (B_ (XBUFFER (buf), name))) { sprintf (name, " *Minibuf-%d*", depth); buf = Fget_buffer_create (build_string (name)); @@ -1096,7 +1096,7 @@ function, instead of the usual behavior. */) int count = SPECPDL_INDEX (); if (BUFFERP (def)) - def = XBUFFER (def)->name; + def = B_ (XBUFFER (def), name); specbind (Qcompletion_ignore_case, read_buffer_completion_ignore_case ? Qt : Qnil); diff --git a/src/msdos.c b/src/msdos.c index eb73f54838d..d37200e700a 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1317,12 +1317,12 @@ IT_frame_up_to_date (struct frame *f) { struct buffer *b = XBUFFER (sw->buffer); - if (EQ (b->cursor_type, Qt)) + if (EQ (B_ (b,cursor_type), Qt)) new_cursor = frame_desired_cursor; - else if (NILP (b->cursor_type)) /* nil means no cursor */ + else if (NILP (B_ (b, cursor_type))) /* nil means no cursor */ new_cursor = Fcons (Qbar, make_number (0)); else - new_cursor = b->cursor_type; + new_cursor = B_ (b, cursor_type); } IT_set_cursor_type (f, new_cursor); diff --git a/src/nsfns.m b/src/nsfns.m index f1bf8b65727..c480c834602 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -605,8 +605,8 @@ ns_set_name_as_filename (struct frame *f) BLOCK_INPUT; pool = [[NSAutoreleasePool alloc] init]; - filename = XBUFFER (buf)->filename; - name = XBUFFER (buf)->name; + filename = B_ (XBUFFER (buf), filename); + name = B_ (XBUFFER (buf), name); if (NILP (name)) { @@ -1428,7 +1428,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : [NSString stringWithUTF8String: SDATA (prompt)]; NSString *dirS = NILP (dir) || !STRINGP (dir) ? - [NSString stringWithUTF8String: SDATA (current_buffer->directory)] : + [NSString stringWithUTF8String: SDATA (B_ (current_buffer, directory))] : [NSString stringWithUTF8String: SDATA (dir)]; NSString *initS = NILP (init) || !STRINGP (init) ? nil : [NSString stringWithUTF8String: SDATA (init)]; diff --git a/src/nsterm.m b/src/nsterm.m index e83b14748df..590a76ba16d 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5783,6 +5783,7 @@ ns_term_shutdown (int sig) win = nwin; condemned = NO; pixel_height = NSHeight (r); + if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; frame = XFRAME (XWINDOW (win)->frame); @@ -5812,6 +5813,7 @@ ns_term_shutdown (int sig) NSTRACE (EmacsScroller_setFrame); /* BLOCK_INPUT; */ pixel_height = NSHeight (newRect); + if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; [super setFrame: newRect]; [self display]; diff --git a/src/print.c b/src/print.c index f47b71087f4..beb14a8b679 100644 --- a/src/print.c +++ b/src/print.c @@ -111,7 +111,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; EMACS_INT old_point_byte = -1, start_point_byte = -1; \ int specpdl_count = SPECPDL_INDEX (); \ int free_print_buffer = 0; \ - int multibyte = !NILP (current_buffer->enable_multibyte_characters); \ + int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); \ Lisp_Object original #define PRINTPREPARE \ @@ -144,10 +144,10 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; if (NILP (printcharfun)) \ { \ Lisp_Object string; \ - if (NILP (current_buffer->enable_multibyte_characters) \ + if (NILP (B_ (current_buffer, enable_multibyte_characters)) \ && ! print_escape_multibyte) \ specbind (Qprint_escape_multibyte, Qt); \ - if (! NILP (current_buffer->enable_multibyte_characters) \ + if (! NILP (B_ (current_buffer, enable_multibyte_characters)) \ && ! print_escape_nonascii) \ specbind (Qprint_escape_nonascii, Qt); \ if (print_buffer != 0) \ @@ -173,7 +173,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; if (NILP (printcharfun)) \ { \ if (print_buffer_pos != print_buffer_pos_byte \ - && NILP (current_buffer->enable_multibyte_characters)) \ + && NILP (B_ (current_buffer, enable_multibyte_characters))) \ { \ unsigned char *temp \ = (unsigned char *) alloca (print_buffer_pos + 1); \ @@ -250,7 +250,7 @@ printchar (unsigned int ch, Lisp_Object fun) else { int multibyte_p - = !NILP (current_buffer->enable_multibyte_characters); + = !NILP (B_ (current_buffer, enable_multibyte_characters)); setup_echo_area_for_printing (multibyte_p); insert_char (ch); @@ -302,7 +302,7 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, job. */ int i; int multibyte_p - = !NILP (current_buffer->enable_multibyte_characters); + = !NILP (B_ (current_buffer, enable_multibyte_characters)); setup_echo_area_for_printing (multibyte_p); message_dolog (ptr, size_byte, 0, multibyte_p); @@ -371,8 +371,8 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) chars = SCHARS (string); else if (! print_escape_nonascii && (EQ (printcharfun, Qt) - ? ! NILP (buffer_defaults.enable_multibyte_characters) - : ! NILP (current_buffer->enable_multibyte_characters))) + ? ! NILP (B_ (&buffer_defaults, enable_multibyte_characters)) + : ! NILP (B_ (current_buffer, enable_multibyte_characters)))) { /* If unibyte string STRING contains 8-bit codes, we must convert STRING to a multibyte string containing the same @@ -504,14 +504,14 @@ temp_output_buffer_setup (const char *bufname) Fkill_all_local_variables (); delete_all_overlays (current_buffer); - current_buffer->directory = old->directory; - current_buffer->read_only = Qnil; - current_buffer->filename = Qnil; - current_buffer->undo_list = Qt; + B_ (current_buffer, directory) = B_ (old, directory); + B_ (current_buffer, read_only) = Qnil; + B_ (current_buffer, filename) = Qnil; + B_ (current_buffer, undo_list) = Qt; eassert (current_buffer->overlays_before == NULL); eassert (current_buffer->overlays_after == NULL); - current_buffer->enable_multibyte_characters - = buffer_defaults.enable_multibyte_characters; + B_ (current_buffer, enable_multibyte_characters) + = B_ (&buffer_defaults, enable_multibyte_characters); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -1062,7 +1062,10 @@ float_to_string (char *buf, double data) { /* Generate the fewest number of digits that represent the floating point value without losing information. */ - dtoastr (buf, FLOAT_TO_STRING_BUFSIZE, 0, 0, data); + dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data); + /* The decimal point must be printed, or the byte compiler can + get confused (Bug#8033). */ + width = 1; } else /* oink oink */ { @@ -1117,8 +1120,7 @@ float_to_string (char *buf, double data) cp[1] = '0'; cp[2] = 0; } - - if (*cp == 0) + else if (*cp == 0) { *cp++ = '.'; *cp++ = '0'; @@ -1854,7 +1856,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag if (!NILP (XWINDOW (obj)->buffer)) { strout (" on ", -1, -1, printcharfun, 0); - print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun); + print_string (B_ (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); } PRINTCHAR ('>'); } @@ -1955,16 +1957,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } else if (BUFFERP (obj)) { - if (NILP (XBUFFER (obj)->name)) + if (NILP (B_ (XBUFFER (obj), name))) strout ("#<killed buffer>", -1, -1, printcharfun, 0); else if (escapeflag) { strout ("#<buffer ", -1, -1, printcharfun, 0); - print_string (XBUFFER (obj)->name, printcharfun); + print_string (B_ (XBUFFER (obj), name), printcharfun); PRINTCHAR ('>'); } else - print_string (XBUFFER (obj)->name, printcharfun); + print_string (B_ (XBUFFER (obj), name), printcharfun); } else if (WINDOW_CONFIGURATIONP (obj)) { @@ -2076,7 +2078,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag sprintf (buf, "at %ld", (long)marker_position (obj)); strout (buf, -1, -1, printcharfun, 0); strout (" in ", -1, -1, printcharfun, 0); - print_string (XMARKER (obj)->buffer->name, printcharfun); + print_string (B_ (XMARKER (obj)->buffer, name), printcharfun); } PRINTCHAR ('>'); break; @@ -2091,7 +2093,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag (long)marker_position (OVERLAY_START (obj)), (long)marker_position (OVERLAY_END (obj))); strout (buf, -1, -1, printcharfun, 0); - print_string (XMARKER (OVERLAY_START (obj))->buffer->name, + print_string (B_ (XMARKER (OVERLAY_START (obj))->buffer, name), printcharfun); } PRINTCHAR ('>'); diff --git a/src/process.c b/src/process.c index d026b9d030b..ec929a919f8 100644 --- a/src/process.c +++ b/src/process.c @@ -719,7 +719,7 @@ get_process (register Lisp_Object name) { proc = Fget_buffer_process (obj); if (NILP (proc)) - error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name)); + error ("Buffer %s has no process", SDATA (B_ (XBUFFER (obj), name))); } else { @@ -1283,12 +1283,12 @@ list_processes_1 (Lisp_Object query_only) w_proc = i; if (!NILP (p->buffer)) { - if (NILP (XBUFFER (p->buffer)->name)) + if (NILP (B_ (XBUFFER (p->buffer), name))) { if (w_buffer < 8) w_buffer = 8; /* (Killed) */ } - else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer))) + else if ((i = SCHARS (B_ (XBUFFER (p->buffer), name)), (i > w_buffer))) w_buffer = i; } if (STRINGP (p->tty_name) @@ -1312,9 +1312,9 @@ list_processes_1 (Lisp_Object query_only) XSETFASTINT (minspace, 1); set_buffer_internal (XBUFFER (Vstandard_output)); - current_buffer->undo_list = Qt; + B_ (current_buffer, undo_list) = Qt; - current_buffer->truncate_lines = Qt; + B_ (current_buffer, truncate_lines) = Qt; write_string ("Proc", -1); Findent_to (i_status, minspace); write_string ("Status", -1); @@ -1397,10 +1397,10 @@ list_processes_1 (Lisp_Object query_only) Findent_to (i_buffer, minspace); if (NILP (p->buffer)) insert_string ("(none)"); - else if (NILP (XBUFFER (p->buffer)->name)) + else if (NILP (B_ (XBUFFER (p->buffer), name))) insert_string ("(Killed)"); else - Finsert (1, &XBUFFER (p->buffer)->name); + Finsert (1, &B_ (XBUFFER (p->buffer), name)); if (!NILP (i_tty)) { @@ -1548,7 +1548,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) { struct gcpro gcpro1, gcpro2; - current_dir = current_buffer->directory; + current_dir = B_ (current_buffer, directory); GCPRO2 (buffer, current_dir); @@ -1560,7 +1560,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) current_dir = expand_and_dir_to_file (current_dir, Qnil); 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)); UNGCPRO; } @@ -2056,7 +2056,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) signal (SIGINT, SIG_DFL); signal (SIGQUIT, SIG_DFL); - /* 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); @@ -2898,8 +2898,8 @@ usage: (make-serial-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; - else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; p->decode_coding_system = val; @@ -2912,8 +2912,8 @@ usage: (make-serial-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; p->encode_coding_system = val; @@ -3723,8 +3723,8 @@ usage: (make-network-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; - else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) /* We dare not decode end-of-line format by setting VAL to Qraw_text, because the existing Emacs Lisp libraries assume that they receive bare code including a sequene of @@ -3759,7 +3759,7 @@ usage: (make-network-process &rest ARGS) */) } else 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 = Qnil; else { @@ -5268,7 +5268,7 @@ read_process_output (Lisp_Object proc, register int channel) /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ XSETBUFFER (obuffer, current_buffer); - okeymap = current_buffer->keymap; + okeymap = B_ (current_buffer, keymap); /* We inhibit quit here instead of just catching it so that hitting ^G when a filter happens to be running won't screw @@ -5359,7 +5359,7 @@ read_process_output (Lisp_Object proc, register int channel) } /* If no filter, write into buffer if it isn't dead. */ - else if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) + else if (!NILP (p->buffer) && !NILP (B_ (XBUFFER (p->buffer), name))) { Lisp_Object old_read_only; EMACS_INT old_begv, old_zv; @@ -5372,13 +5372,13 @@ read_process_output (Lisp_Object proc, register int channel) Fset_buffer (p->buffer); opoint = PT; opoint_byte = PT_BYTE; - old_read_only = current_buffer->read_only; + old_read_only = B_ (current_buffer, read_only); old_begv = BEGV; old_zv = ZV; old_begv_byte = BEGV_BYTE; old_zv_byte = ZV_BYTE; - current_buffer->read_only = Qnil; + B_ (current_buffer, read_only) = Qnil; /* Insert new output into buffer at the current end-of-output marker, @@ -5423,7 +5423,7 @@ read_process_output (Lisp_Object proc, register int channel) p->decoding_carryover = coding->carryover_bytes; } /* Adjust the multibyteness of TEXT to that of the buffer. */ - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (B_ (current_buffer, enable_multibyte_characters)) != ! STRING_MULTIBYTE (text)) text = (STRING_MULTIBYTE (text) ? Fstring_as_unibyte (text) @@ -5467,7 +5467,7 @@ read_process_output (Lisp_Object proc, register int channel) Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); - current_buffer->read_only = old_read_only; + B_ (current_buffer, read_only) = old_read_only; SET_PT_BOTH (opoint, opoint_byte); } /* Handling the process output should not deactivate the mark. */ @@ -5525,7 +5525,7 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, if ((STRINGP (object) && STRING_MULTIBYTE (object)) || (BUFFERP (object) - && !NILP (XBUFFER (object)->enable_multibyte_characters)) + && !NILP (B_ (XBUFFER (object), enable_multibyte_characters))) || EQ (object, Qt)) { p->encode_coding_system @@ -6564,7 +6564,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; XSETBUFFER (obuffer, current_buffer); - okeymap = current_buffer->keymap; + okeymap = B_ (current_buffer, keymap); /* There's no good reason to let sentinels change the current buffer, and many callers of accept-process-output, sit-for, and @@ -6714,7 +6714,7 @@ status_notify (struct Lisp_Process *deleting_process) /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ - if (NILP (XBUFFER (buffer)->name)) + if (NILP (B_ (XBUFFER (buffer), name))) continue; Fset_buffer (buffer); @@ -6731,13 +6731,13 @@ status_notify (struct Lisp_Process *deleting_process) before = PT; before_byte = PT_BYTE; - tem = current_buffer->read_only; - current_buffer->read_only = Qnil; + tem = B_ (current_buffer, read_only); + B_ (current_buffer, read_only) = Qnil; insert_string ("\nProcess "); Finsert (1, &p->name); insert_string (" "); Finsert (1, &msg); - current_buffer->read_only = tem; + B_ (current_buffer, read_only) = tem; set_marker_both (p->mark, p->buffer, PT, PT_BYTE); if (opoint >= before) @@ -7136,7 +7136,7 @@ setup_process_coding_systems (Lisp_Object process) ; else if (BUFFERP (p->buffer)) { - if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters)) + if (NILP (B_ (XBUFFER (p->buffer), enable_multibyte_characters))) coding_system = raw_text_coding_system (coding_system); } setup_coding_system (coding_system, proc_decode_coding_system[inch]); diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h index 4c3b84dfe4c..34814687597 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h @@ -181,7 +181,7 @@ struct sigaction { #define HAVE_MENUS 1 #endif -#define MODE_LINE_BINARY_TEXT(_b_) (NILP ((_b_)->buffer_file_type) ? "T" : "B") +#define MODE_LINE_BINARY_TEXT(_b_) (NILP (B_(_b_,buffer_file_type)) ? "T" : "B") /* Get some redefinitions in place. */ diff --git a/src/s/msdos.h b/src/s/msdos.h index 88afaa83455..a1d23521a0a 100644 --- a/src/s/msdos.h +++ b/src/s/msdos.h @@ -92,7 +92,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ /* Mode line description of a buffer's type. */ -#define MODE_LINE_BINARY_TEXT(buf) (NILP(buf->buffer_file_type) ? "T" : "B") +#define MODE_LINE_BINARY_TEXT(buf) (NILP(B_(buf,buffer_file_type)) ? "T" : "B") /* We have (the code to control) a mouse. */ #define HAVE_MOUSE diff --git a/src/search.c b/src/search.c index 09dae0ed0f5..a80e20a8a8a 100644 --- a/src/search.c +++ b/src/search.c @@ -157,7 +157,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, Lisp_Object tra /* If the compiled pattern hard codes some of the contents of the syntax-table, it can only be reused with *this* syntax table. */ - cp->syntax_table = cp->buf.used_syntax ? current_buffer->syntax_table : Qt; + cp->syntax_table = cp->buf.used_syntax ? B_ (current_buffer, syntax_table) : Qt; re_set_whitespace_regexp (NULL); @@ -236,7 +236,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object tra && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) && cp->posix == posix && (EQ (cp->syntax_table, Qt) - || EQ (cp->syntax_table, current_buffer->syntax_table)) + || EQ (cp->syntax_table, B_ (current_buffer, syntax_table))) && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)) && cp->buf.charset_unibyte == charset_unibyte) break; @@ -285,17 +285,17 @@ looking_at_1 (Lisp_Object string, int posix) save_search_regs (); /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] - = current_buffer->case_eqv_table; + XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] + = B_ (current_buffer, case_eqv_table); CHECK_STRING (string); bufp = compile_pattern (string, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), - (!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), posix, - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (B_ (current_buffer, enable_multibyte_characters))); immediate_quit = 1; QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ @@ -400,14 +400,14 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int p } /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] - = current_buffer->case_eqv_table; + XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] + = B_ (current_buffer, case_eqv_table); bufp = compile_pattern (regexp, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), - (!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), posix, STRING_MULTIBYTE (string)); immediate_quit = 1; @@ -586,7 +586,7 @@ fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_IN s2 = 0; } re_match_object = Qnil; - multibyte = ! NILP (current_buffer->enable_multibyte_characters); + multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); } buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); @@ -608,7 +608,7 @@ fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_IN static void newline_cache_on_off (struct buffer *buf) { - if (NILP (buf->cache_long_line_scans)) + if (NILP (B_ (buf, cache_long_line_scans))) { /* It should be off. */ if (buf->newline_cache) @@ -996,15 +996,15 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, } /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] - = current_buffer->case_eqv_table; + XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] + = B_ (current_buffer, case_eqv_table); np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE, - (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_canon_table + (!NILP (B_ (current_buffer, case_fold_search)) + ? B_ (current_buffer, case_canon_table) : Qnil), - (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_eqv_table + (!NILP (B_ (current_buffer, case_fold_search)) + ? B_ (current_buffer, case_eqv_table) : Qnil), posix); if (np <= 0) @@ -1133,7 +1133,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : &search_regs_1), trt, posix, - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (B_ (current_buffer, enable_multibyte_characters))); immediate_quit = 1; /* Quit immediately if user types ^G, because letting this function finish @@ -1254,7 +1254,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT raw_pattern_size; EMACS_INT raw_pattern_size_byte; unsigned char *patbuf; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); unsigned char *base_pat; /* Set to positive if we find a non-ASCII char that need translation. Otherwise set to zero later. */ @@ -1451,7 +1451,7 @@ simple_search (EMACS_INT n, unsigned char *pat, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT lim, EMACS_INT lim_byte) { - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); int forward = n > 0; /* Number of buffer bytes matched. Note that this may be different from len_byte in a multibyte buffer. */ @@ -1671,7 +1671,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat, register EMACS_INT i; register int j; unsigned char *pat, *pat_end; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); unsigned char simple_translate[0400]; /* These are set to the preceding bytes of a byte to be translated @@ -2639,7 +2639,7 @@ since only regular expressions have distinguished subexpressions. */) EMACS_INT length = SBYTES (newtext); unsigned char *substed; EMACS_INT substed_alloc_size, substed_len; - int buf_multibyte = !NILP (current_buffer->enable_multibyte_characters); + int buf_multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); int str_multibyte = STRING_MULTIBYTE (newtext); Lisp_Object rev_tbl; int really_changed = 0; diff --git a/src/syntax.c b/src/syntax.c index 2f47d73d695..9aa34014f91 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -277,7 +277,7 @@ update_syntax_table (EMACS_INT charpos, int count, int init, else { gl_state.use_global = 0; - gl_state.current_syntax_table = current_buffer->syntax_table; + gl_state.current_syntax_table = B_ (current_buffer, syntax_table); } } @@ -363,7 +363,7 @@ char_quoted (EMACS_INT charpos, EMACS_INT bytepos) static INLINE EMACS_INT dec_bytepos (EMACS_INT bytepos) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) return bytepos - 1; DEC_POS (bytepos); @@ -779,7 +779,7 @@ DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, This is the one specified by the current buffer. */) (void) { - return current_buffer->syntax_table; + return B_ (current_buffer, syntax_table); } DEFUN ("standard-syntax-table", Fstandard_syntax_table, @@ -824,7 +824,7 @@ One argument, a syntax table. */) { int idx; check_syntax_table (table); - current_buffer->syntax_table = table; + B_ (current_buffer, syntax_table) = table; /* Indicate that this buffer now has a specified syntax table. */ idx = PER_BUFFER_VAR_IDX (syntax_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); @@ -1035,7 +1035,7 @@ usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */) CHECK_CHARACTER (c); if (NILP (syntax_table)) - syntax_table = current_buffer->syntax_table; + syntax_table = B_ (current_buffer, syntax_table); else check_syntax_table (syntax_table); @@ -1450,7 +1450,7 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl if (XINT (lim) < BEGV) XSETFASTINT (lim, BEGV); - multibyte = (!NILP (current_buffer->enable_multibyte_characters) + multibyte = (!NILP (B_ (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); string_multibyte = SBYTES (string) > SCHARS (string); @@ -1936,7 +1936,7 @@ skip_syntaxes (int forwardp, Lisp_Object string, Lisp_Object lim) if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) return make_number (0); - multibyte = (!NILP (current_buffer->enable_multibyte_characters) + multibyte = (!NILP (B_ (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); memset (fastmap, 0, sizeof fastmap); @@ -2703,7 +2703,7 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf while (from > stop) { temp_pos = from_byte; - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (B_ (current_buffer, enable_multibyte_characters))) DEC_POS (temp_pos); else temp_pos--; diff --git a/src/syntax.h b/src/syntax.h index bea66d1fada..75937a7c121 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -24,7 +24,7 @@ extern void update_syntax_table (EMACS_INT, int, int, Lisp_Object); /* The standard syntax table is stored where it will automatically be used in all new buffers. */ -#define Vstandard_syntax_table buffer_defaults.syntax_table +#define Vstandard_syntax_table B_ (&buffer_defaults, syntax_table) /* A syntax table is a chartable whose elements are cons cells (CODE+FLAGS . MATCHING-CHAR). MATCHING-CHAR can be nil if the char @@ -79,7 +79,7 @@ enum syntaxcode # define CURRENT_SYNTAX_TABLE gl_state.current_syntax_table #else # define SYNTAX_ENTRY SYNTAX_ENTRY_INT -# define CURRENT_SYNTAX_TABLE current_buffer->syntax_table +# define CURRENT_SYNTAX_TABLE B_ (current_buffer, syntax_table) #endif #define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) @@ -204,7 +204,7 @@ extern char syntax_code_spec[16]; do \ { \ gl_state.use_global = 0; \ - gl_state.current_syntax_table = current_buffer->syntax_table; \ + gl_state.current_syntax_table = B_ (current_buffer, syntax_table); \ } while (0) /* This macro should be called with FROM at the start of forward diff --git a/src/undo.c b/src/undo.c index 933982ec30c..f6953fabfec 100644 --- a/src/undo.c +++ b/src/undo.c @@ -73,12 +73,12 @@ record_point (EMACS_INT pt) Fundo_boundary (); last_undo_buffer = current_buffer; - if (CONSP (current_buffer->undo_list)) + if (CONSP (B_ (current_buffer, undo_list))) { /* Set AT_BOUNDARY to 1 only when we have nothing other than marker adjustment before undo boundary. */ - Lisp_Object tail = current_buffer->undo_list, elt; + Lisp_Object tail = B_ (current_buffer, undo_list), elt; while (1) { @@ -103,8 +103,8 @@ record_point (EMACS_INT pt) if (at_boundary && current_buffer == last_boundary_buffer && last_boundary_position != pt) - current_buffer->undo_list - = Fcons (make_number (last_boundary_position), current_buffer->undo_list); + B_ (current_buffer, undo_list) + = Fcons (make_number (last_boundary_position), B_ (current_buffer, undo_list)); } /* Record an insertion that just happened or is about to happen, @@ -117,17 +117,17 @@ record_insert (EMACS_INT beg, EMACS_INT length) { Lisp_Object lbeg, lend; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (B_ (current_buffer, undo_list), Qt)) return; record_point (beg); /* If this is following another insertion and consecutive with it in the buffer, combine the two. */ - if (CONSP (current_buffer->undo_list)) + if (CONSP (B_ (current_buffer, undo_list))) { Lisp_Object elt; - elt = XCAR (current_buffer->undo_list); + elt = XCAR (B_ (current_buffer, undo_list)); if (CONSP (elt) && INTEGERP (XCAR (elt)) && INTEGERP (XCDR (elt)) @@ -140,8 +140,8 @@ record_insert (EMACS_INT beg, EMACS_INT length) XSETFASTINT (lbeg, beg); XSETINT (lend, beg + length); - current_buffer->undo_list = Fcons (Fcons (lbeg, lend), - current_buffer->undo_list); + B_ (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), + B_ (current_buffer, undo_list)); } /* Record that a deletion is about to take place, @@ -152,7 +152,7 @@ record_delete (EMACS_INT beg, Lisp_Object string) { Lisp_Object sbeg; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (B_ (current_buffer, undo_list), Qt)) return; if (PT == beg + SCHARS (string)) @@ -166,8 +166,8 @@ record_delete (EMACS_INT beg, Lisp_Object string) record_point (beg); } - current_buffer->undo_list - = Fcons (Fcons (string, sbeg), current_buffer->undo_list); + B_ (current_buffer, undo_list) + = Fcons (Fcons (string, sbeg), B_ (current_buffer, undo_list)); } /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT. @@ -178,7 +178,7 @@ record_delete (EMACS_INT beg, Lisp_Object string) void record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) { - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (B_ (current_buffer, undo_list), Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ @@ -189,9 +189,9 @@ record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) Fundo_boundary (); last_undo_buffer = current_buffer; - current_buffer->undo_list + B_ (current_buffer, undo_list) = Fcons (Fcons (marker, make_number (adjustment)), - current_buffer->undo_list); + B_ (current_buffer, undo_list)); } /* Record that a replacement is about to take place, @@ -215,7 +215,7 @@ record_first_change (void) Lisp_Object high, low; struct buffer *base_buffer = current_buffer; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (B_ (current_buffer, undo_list), Qt)) return; if (current_buffer != last_undo_buffer) @@ -227,7 +227,7 @@ record_first_change (void) XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); XSETFASTINT (low, base_buffer->modtime & 0xffff); - current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); + B_ (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), B_ (current_buffer, undo_list)); } /* Record a change in property PROP (whose old value was VAL) @@ -242,7 +242,7 @@ record_property_change (EMACS_INT beg, EMACS_INT length, struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); int boundary = 0; - if (EQ (buf->undo_list, Qt)) + if (EQ (B_ (buf, undo_list), Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ @@ -265,7 +265,7 @@ record_property_change (EMACS_INT beg, EMACS_INT length, XSETINT (lbeg, beg); XSETINT (lend, beg + length); entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); - current_buffer->undo_list = Fcons (entry, current_buffer->undo_list); + B_ (current_buffer, undo_list) = Fcons (entry, B_ (current_buffer, undo_list)); current_buffer = obuf; } @@ -277,9 +277,9 @@ but another undo command will undo to the previous boundary. */) (void) { Lisp_Object tem; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (B_ (current_buffer, undo_list), Qt)) return Qnil; - tem = Fcar (current_buffer->undo_list); + tem = Fcar (B_ (current_buffer, undo_list)); if (!NILP (tem)) { /* One way or another, cons nil onto the front of the undo list. */ @@ -287,12 +287,12 @@ but another undo command will undo to the previous boundary. */) { /* If we have preallocated the cons cell to use here, use that one. */ - XSETCDR (pending_boundary, current_buffer->undo_list); - current_buffer->undo_list = pending_boundary; + XSETCDR (pending_boundary, B_ (current_buffer, undo_list)); + B_ (current_buffer, undo_list) = pending_boundary; pending_boundary = Qnil; } else - current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); + B_ (current_buffer, undo_list) = Fcons (Qnil, B_ (current_buffer, undo_list)); } last_boundary_position = PT; last_boundary_buffer = current_buffer; @@ -321,7 +321,7 @@ truncate_undo_list (struct buffer *b) record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); set_buffer_internal (b); - list = b->undo_list; + list = B_ (b, undo_list); prev = Qnil; next = list; @@ -433,7 +433,7 @@ truncate_undo_list (struct buffer *b) XSETCDR (last_boundary, Qnil); /* There's nothing we decided to keep, so clear it out. */ else - b->undo_list = Qnil; + B_ (b, undo_list) = Qnil; unbind_to (count, Qnil); } @@ -470,13 +470,13 @@ Return what remains of the list. */) /* In a writable buffer, enable undoing read-only text that is so because of text properties. */ - if (NILP (current_buffer->read_only)) + if (NILP (B_ (current_buffer, read_only))) specbind (Qinhibit_read_only, Qt); /* Don't let `intangible' properties interfere with undo. */ specbind (Qinhibit_point_motion_hooks, Qt); - oldlist = current_buffer->undo_list; + oldlist = B_ (current_buffer, undo_list); while (arg > 0) { @@ -631,9 +631,9 @@ Return what remains of the list. */) so the test in `undo' for continuing an undo series will work right. */ if (did_apply - && EQ (oldlist, current_buffer->undo_list)) - current_buffer->undo_list - = Fcons (list3 (Qapply, Qcdr, Qnil), current_buffer->undo_list); + && EQ (oldlist, B_ (current_buffer, undo_list))) + B_ (current_buffer, undo_list) + = Fcons (list3 (Qapply, Qcdr, Qnil), B_ (current_buffer, undo_list)); UNGCPRO; return unbind_to (count, list); diff --git a/src/w32fns.c b/src/w32fns.c index b09bb0b5b5f..64e073bedb7 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -5225,7 +5225,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - current_buffer->truncate_lines = Qnil; + B_ (current_buffer, truncate_lines) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5655,7 +5655,7 @@ Text larger than the specified size is clipped. */) /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); - current_buffer->truncate_lines = Qnil; + B_ (current_buffer, truncate_lines) = Qnil; clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); @@ -6162,7 +6162,7 @@ an integer representing a ShowWindow flag: CHECK_STRING (document); /* Encode filename, current directory and parameters. */ - current_dir = ENCODE_FILE (current_buffer->directory); + current_dir = ENCODE_FILE (B_ (current_buffer, directory)); document = ENCODE_FILE (document); if (STRINGP (parameters)) parameters = ENCODE_SYSTEM (parameters); diff --git a/src/window.c b/src/window.c index abf01758c3f..4d700cfad5e 100644 --- a/src/window.c +++ b/src/window.c @@ -1359,8 +1359,8 @@ window_display_table (struct window *w) { struct buffer *b = XBUFFER (w->buffer); - if (DISP_TABLE_P (b->display_table)) - dp = XCHAR_TABLE (b->display_table); + if (DISP_TABLE_P (B_ (b, display_table))) + dp = XCHAR_TABLE (B_ (b, display_table)); else if (DISP_TABLE_P (Vstandard_display_table)) dp = XCHAR_TABLE (Vstandard_display_table); } @@ -1414,9 +1414,9 @@ unshow_buffer (register struct window *w) So don't clobber point in that buffer. */ if (! EQ (buf, XWINDOW (selected_window)->buffer) /* This line helps to fix Horsley's testbug.el bug. */ - && !(WINDOWP (b->last_selected_window) - && w != XWINDOW (b->last_selected_window) - && EQ (buf, XWINDOW (b->last_selected_window)->buffer))) + && !(WINDOWP (B_ (b, last_selected_window)) + && w != XWINDOW (B_ (b, last_selected_window)) + && EQ (buf, XWINDOW (B_ (b, last_selected_window))->buffer))) temp_set_point_both (b, clip_to_bounds (BUF_BEGV (b), XMARKER (w->pointm)->charpos, @@ -1425,9 +1425,9 @@ unshow_buffer (register struct window *w) marker_byte_position (w->pointm), BUF_ZV_BYTE (b))); - if (WINDOWP (b->last_selected_window) - && w == XWINDOW (b->last_selected_window)) - b->last_selected_window = Qnil; + if (WINDOWP (B_ (b, last_selected_window)) + && w == XWINDOW (B_ (b, last_selected_window))) + B_ (b, last_selected_window) = Qnil; } /* Put replacement into the window structure in place of old. */ @@ -2325,7 +2325,7 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame /* Check for a window that has a killed buffer. */ case CHECK_ALL_WINDOWS: if (! NILP (w->buffer) - && NILP (XBUFFER (w->buffer)->name)) + && NILP (B_ (XBUFFER (w->buffer), name))) abort (); break; @@ -2729,7 +2729,7 @@ window_min_size_2 (struct window *w, int width_p, int safe_p) { int safe_size = (MIN_SAFE_WINDOW_HEIGHT + ((BUFFERP (w->buffer) - && !NILP (XBUFFER (w->buffer)->mode_line_format)) + && !NILP (B_ (XBUFFER (w->buffer), mode_line_format))) ? 1 : 0)); return safe_p ? safe_size : max (window_min_height, safe_size); @@ -3360,15 +3360,15 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int w->buffer = buffer; if (EQ (window, selected_window)) - b->last_selected_window = window; + B_ (b, last_selected_window) = window; /* Let redisplay errors through. */ b->display_error_modiff = 0; /* Update time stamps of buffer display. */ - if (INTEGERP (b->display_count)) - XSETINT (b->display_count, XINT (b->display_count) + 1); - b->display_time = Fcurrent_time (); + if (INTEGERP (B_ (b, display_count))) + XSETINT (B_ (b, display_count), XINT (B_ (b, display_count)) + 1); + B_ (b, display_time) = Fcurrent_time (); XSETFASTINT (w->window_end_pos, 0); XSETFASTINT (w->window_end_vpos, 0); @@ -3421,18 +3421,18 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int w->left_margin_cols = w->right_margin_cols = Qnil; Fset_window_fringes (window, - b->left_fringe_width, b->right_fringe_width, - b->fringes_outside_margins); + B_ (b, left_fringe_width), B_ (b, right_fringe_width), + B_ (b, fringes_outside_margins)); Fset_window_scroll_bars (window, - b->scroll_bar_width, - b->vertical_scroll_bar_type, Qnil); + B_ (b, scroll_bar_width), + B_ (b, vertical_scroll_bar_type), Qnil); w->left_margin_cols = save_left; w->right_margin_cols = save_right; Fset_window_margins (window, - b->left_margin_cols, b->right_margin_cols); + B_ (b, left_margin_cols), B_ (b, right_margin_cols)); } if (run_hooks_p) @@ -3469,7 +3469,7 @@ This function runs `window-scroll-functions' before running XSETWINDOW (window, w); buffer = Fget_buffer (buffer_or_name); CHECK_BUFFER (buffer); - if (NILP (XBUFFER (buffer)->name)) + if (NILP (B_ (XBUFFER (buffer), name))) error ("Attempt to display deleted buffer"); tem = w->buffer; @@ -3481,7 +3481,7 @@ This function runs `window-scroll-functions' before running if (EQ (tem, buffer)) return Qnil; else if (EQ (w->dedicated, Qt)) - error ("Window is dedicated to `%s'", SDATA (XBUFFER (tem)->name)); + error ("Window is dedicated to `%s'", SDATA (B_ (XBUFFER (tem), name))); else w->dedicated = Qnil; @@ -3517,7 +3517,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) record_buffer (w->buffer); } - if (EQ (window, selected_window)) + if (EQ (window, selected_window) && !inhibit_point_swap) return window; sf = SELECTED_FRAME (); @@ -3552,7 +3552,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) Fset_buffer (w->buffer); - XBUFFER (w->buffer)->last_selected_window = window; + B_ (XBUFFER (w->buffer), last_selected_window) = window; /* Go to the point recorded in the window. This is important when the buffer is in more @@ -3640,7 +3640,7 @@ displaying that buffer. */) if (STRINGP (object)) object = Fget_buffer (object); - if (BUFFERP (object) && !NILP (XBUFFER (object)->name)) + if (BUFFERP (object) && !NILP (B_ (XBUFFER (object), name))) { /* Walk all windows looking for buffer, and force update of each of those windows. */ @@ -3663,7 +3663,7 @@ temp_output_buffer_show (register Lisp_Object buf) register Lisp_Object window; register struct window *w; - XBUFFER (buf)->directory = current_buffer->directory; + B_ (XBUFFER (buf), directory) = B_ (current_buffer, directory); Fset_buffer (buf); BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; @@ -5878,7 +5878,7 @@ the return value is nil. Otherwise the value is t. */) saved_windows = XVECTOR (data->saved_windows); new_current_buffer = data->current_buffer; - if (NILP (XBUFFER (new_current_buffer)->name)) + if (NILP (B_ (XBUFFER (new_current_buffer), name))) new_current_buffer = Qnil; else { @@ -6063,14 +6063,14 @@ the return value is nil. Otherwise the value is t. */) w->buffer = p->buffer; else { - if (!NILP (XBUFFER (p->buffer)->name)) + if (!NILP (B_ (XBUFFER (p->buffer), name))) /* If saved buffer is alive, install it. */ { w->buffer = p->buffer; w->start_at_line_beg = p->start_at_line_beg; set_marker_restricted (w->start, p->start, w->buffer); set_marker_restricted (w->pointm, p->pointm, w->buffer); - Fset_marker (XBUFFER (w->buffer)->mark, + Fset_marker (B_ (XBUFFER (w->buffer), mark), p->mark, w->buffer); /* As documented in Fcurrent_window_configuration, don't @@ -6080,7 +6080,7 @@ the return value is nil. Otherwise the value is t. */) && XBUFFER (p->buffer) == current_buffer) Fgoto_char (w->pointm); } - else if (NILP (w->buffer) || NILP (XBUFFER (w->buffer)->name)) + else if (NILP (w->buffer) || NILP (B_ (XBUFFER (w->buffer), name))) /* Else unless window has a live buffer, get one. */ { w->buffer = Fcdr (Fcar (Vbuffer_alist)); @@ -6121,7 +6121,7 @@ the return value is nil. Otherwise the value is t. */) has been restored into it. We already swapped out that point from that window's old buffer. */ select_window (data->current_window, Qnil, 1); - XBUFFER (XWINDOW (selected_window)->buffer)->last_selected_window + B_ (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) = selected_window; if (NILP (data->focus_frame) @@ -6322,7 +6322,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) p->start = Fcopy_marker (w->start, Qnil); p->start_at_line_beg = w->start_at_line_beg; - tem = XBUFFER (w->buffer)->mark; + tem = B_ (XBUFFER (w->buffer), mark); p->mark = Fcopy_marker (tem, Qnil); } else diff --git a/src/xdisp.c b/src/xdisp.c index b9b77e34b9d..68f7835f0d7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1210,12 +1210,12 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y, if (WINDOW_WANTS_MODELINE_P (w)) current_mode_line_height = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), - current_buffer->mode_line_format); + B_ (current_buffer, mode_line_format)); if (WINDOW_WANTS_HEADER_LINE_P (w)) current_header_line_height = display_mode_line (w, HEADER_LINE_FACE_ID, - current_buffer->header_line_format); + B_ (current_buffer, header_line_format)); start_display (&it, w, top); move_it_to (&it, charpos, -1, it.last_visible_y-1, -1, @@ -2405,10 +2405,10 @@ init_iterator (struct it *it, struct window *w, if (base_face_id == DEFAULT_FACE_ID && FRAME_WINDOW_P (it->f)) { - if (NATNUMP (current_buffer->extra_line_spacing)) - it->extra_line_spacing = XFASTINT (current_buffer->extra_line_spacing); - else if (FLOATP (current_buffer->extra_line_spacing)) - it->extra_line_spacing = (XFLOAT_DATA (current_buffer->extra_line_spacing) + if (NATNUMP (B_ (current_buffer, extra_line_spacing))) + it->extra_line_spacing = XFASTINT (B_ (current_buffer, extra_line_spacing)); + else if (FLOATP (B_ (current_buffer, extra_line_spacing))) + it->extra_line_spacing = (XFLOAT_DATA (B_ (current_buffer, extra_line_spacing)) * FRAME_LINE_HEIGHT (it->f)); else if (it->f->extra_line_spacing > 0) it->extra_line_spacing = it->f->extra_line_spacing; @@ -2431,36 +2431,36 @@ init_iterator (struct it *it, struct window *w, it->override_ascent = -1; /* Are control characters displayed as `^C'? */ - it->ctl_arrow_p = !NILP (current_buffer->ctl_arrow); + it->ctl_arrow_p = !NILP (B_ (current_buffer, ctl_arrow)); /* -1 means everything between a CR and the following line end is invisible. >0 means lines indented more than this value are invisible. */ - it->selective = (INTEGERP (current_buffer->selective_display) - ? XFASTINT (current_buffer->selective_display) - : (!NILP (current_buffer->selective_display) + it->selective = (INTEGERP (B_ (current_buffer, selective_display)) + ? XFASTINT (B_ (current_buffer, selective_display)) + : (!NILP (B_ (current_buffer, selective_display)) ? -1 : 0)); it->selective_display_ellipsis_p - = !NILP (current_buffer->selective_display_ellipses); + = !NILP (B_ (current_buffer, selective_display_ellipses)); /* Display table to use. */ it->dp = window_display_table (w); /* Are multibyte characters enabled in current_buffer? */ - it->multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + it->multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); /* Do we need to reorder bidirectional text? Not if this is a unibyte buffer: by definition, none of the single-byte characters are strong R2L, so no reordering is needed. And bidi.c doesn't support unibyte buffers anyway. */ it->bidi_p - = !NILP (current_buffer->bidi_display_reordering) && it->multibyte_p; + = !NILP (B_ (current_buffer, bidi_display_reordering)) && it->multibyte_p; /* Non-zero if we should highlight the region. */ highlight_region_p = (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active) - && XMARKER (current_buffer->mark)->buffer != 0); + && !NILP (B_ (current_buffer, mark_active)) + && XMARKER (B_ (current_buffer, mark))->buffer != 0); /* Set IT->region_beg_charpos and IT->region_end_charpos to the start and end of a visible region in window IT->w. Set both to @@ -2477,7 +2477,7 @@ init_iterator (struct it *it, struct window *w, && WINDOWP (minibuf_selected_window) && w == XWINDOW (minibuf_selected_window)))) { - EMACS_INT charpos = marker_position (current_buffer->mark); + EMACS_INT charpos = marker_position (B_ (current_buffer, mark)); it->region_beg_charpos = min (PT, charpos); it->region_end_charpos = max (PT, charpos); } @@ -2494,7 +2494,7 @@ init_iterator (struct it *it, struct window *w, it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger); /* Correct bogus values of tab_width. */ - it->tab_width = XINT (current_buffer->tab_width); + it->tab_width = XINT (B_ (current_buffer, tab_width)); if (it->tab_width <= 0 || it->tab_width > 1000) it->tab_width = 8; @@ -2508,8 +2508,8 @@ init_iterator (struct it *it, struct window *w, && (WINDOW_TOTAL_COLS (it->w) < XINT (Vtruncate_partial_width_windows)))))) it->line_wrap = TRUNCATE; - else if (NILP (current_buffer->truncate_lines)) - it->line_wrap = NILP (current_buffer->word_wrap) + else if (NILP (B_ (current_buffer, truncate_lines))) + it->line_wrap = NILP (B_ (current_buffer, word_wrap)) ? WINDOW_WRAP : WORD_WRAP; else it->line_wrap = TRUNCATE; @@ -2611,9 +2611,9 @@ init_iterator (struct it *it, struct window *w, { /* Note the paragraph direction that this buffer wants to use. */ - if (EQ (current_buffer->bidi_paragraph_direction, Qleft_to_right)) + if (EQ (B_ (current_buffer, bidi_paragraph_direction), Qleft_to_right)) it->paragraph_embedding = L2R; - else if (EQ (current_buffer->bidi_paragraph_direction, Qright_to_left)) + else if (EQ (B_ (current_buffer, bidi_paragraph_direction), Qright_to_left)) it->paragraph_embedding = R2L; else it->paragraph_embedding = NEUTRAL_DIR; @@ -5411,7 +5411,7 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p) it->method = GET_FROM_BUFFER; it->object = it->w->buffer; it->area = TEXT_AREA; - it->multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + it->multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); it->sp = 0; it->string_from_display_prop_p = 0; it->face_before_selective_p = 0; @@ -7919,7 +7919,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); - current_buffer->undo_list = Qt; + B_ (current_buffer, undo_list) = Qt; oldpoint = message_dolog_marker1; set_marker_restricted (oldpoint, make_number (PT), Qnil); @@ -7943,7 +7943,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) /* Insert the string--maybe converting multibyte to single byte or vice versa, so that all the text fits the buffer. */ if (multibyte - && NILP (current_buffer->enable_multibyte_characters)) + && NILP (B_ (current_buffer, enable_multibyte_characters))) { EMACS_INT i; int c, char_bytes; @@ -7961,7 +7961,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) } } else if (! multibyte - && ! NILP (current_buffer->enable_multibyte_characters)) + && ! NILP (B_ (current_buffer, enable_multibyte_characters))) { EMACS_INT i; int c, char_bytes; @@ -8460,7 +8460,7 @@ update_echo_area (void) Lisp_Object string; string = Fcurrent_message (); message3 (string, SBYTES (string), - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (B_ (current_buffer, enable_multibyte_characters))); } } @@ -8475,7 +8475,7 @@ ensure_echo_area_buffers (void) for (i = 0; i < 2; ++i) if (!BUFFERP (echo_buffer[i]) - || NILP (XBUFFER (echo_buffer[i])->name)) + || NILP (B_ (XBUFFER (echo_buffer[i]), name))) { char name[30]; Lisp_Object old_buffer; @@ -8484,7 +8484,7 @@ ensure_echo_area_buffers (void) old_buffer = echo_buffer[i]; sprintf (name, " *Echo Area %d*", i); echo_buffer[i] = Fget_buffer_create (build_string (name)); - XBUFFER (echo_buffer[i])->truncate_lines = Qnil; + B_ (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; /* to force word wrap in echo area - it was decided to postpone this*/ /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ @@ -8577,8 +8577,8 @@ with_echo_area_buffer (struct window *w, int which, set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); } - current_buffer->undo_list = Qt; - current_buffer->read_only = Qnil; + B_ (current_buffer, undo_list) = Qt; + B_ (current_buffer, read_only) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -8691,7 +8691,7 @@ setup_echo_area_for_printing (int multibyte_p) /* Switch to that buffer and clear it. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - current_buffer->truncate_lines = Qnil; + B_ (current_buffer, truncate_lines) = Qnil; if (Z > BEG) { @@ -8705,7 +8705,7 @@ setup_echo_area_for_printing (int multibyte_p) /* Set up the buffer for the multibyteness we need. */ if (multibyte_p - != !NILP (current_buffer->enable_multibyte_characters)) + != !NILP (B_ (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (multibyte_p ? Qt : Qnil); /* Raise the frame containing the echo area. */ @@ -8734,7 +8734,7 @@ setup_echo_area_for_printing (int multibyte_p) { /* Someone switched buffers between print requests. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - current_buffer->truncate_lines = Qnil; + B_ (current_buffer, truncate_lines) = Qnil; } } } @@ -9177,12 +9177,12 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby /* Change multibyteness of the echo buffer appropriately. */ if (message_enable_multibyte - != !NILP (current_buffer->enable_multibyte_characters)) + != !NILP (B_ (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); - current_buffer->truncate_lines = message_truncate_lines ? Qt : Qnil; - if (!NILP (current_buffer->bidi_display_reordering)) - current_buffer->bidi_paragraph_direction = Qleft_to_right; + B_ (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; + if (!NILP (B_ (current_buffer, bidi_display_reordering))) + B_ (current_buffer, bidi_paragraph_direction) = Qleft_to_right; /* Insert new message at BEG. */ TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -9205,7 +9205,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby if (nbytes == 0) nbytes = strlen (s); - if (multibyte_p && NILP (current_buffer->enable_multibyte_characters)) + if (multibyte_p && NILP (B_ (current_buffer, enable_multibyte_characters))) { /* Convert from multi-byte to single-byte. */ EMACS_INT i; @@ -9223,7 +9223,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby } } else if (!multibyte_p - && !NILP (current_buffer->enable_multibyte_characters)) + && !NILP (B_ (current_buffer, enable_multibyte_characters))) { /* Convert from single-byte to multi-byte. */ EMACS_INT i; @@ -9808,7 +9808,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) < BUF_MODIFF (XBUFFER (w->buffer))) != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) - && !NILP (XBUFFER (w->buffer)->mark_active)) + && !NILP (B_ (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; @@ -10006,7 +10006,7 @@ update_tool_bar (struct frame *f, int save_match_data) < BUF_MODIFF (XBUFFER (w->buffer))) != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) - && !NILP (XBUFFER (w->buffer)->mark_active)) + && !NILP (B_ (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; @@ -11097,8 +11097,8 @@ text_outside_line_unchanged_p (struct window *w, /* If selective display, can't optimize if changes start at the beginning of the line. */ if (unchanged_p - && INTEGERP (current_buffer->selective_display) - && XINT (current_buffer->selective_display) > 0 + && INTEGERP (B_ (current_buffer, selective_display)) + && XINT (B_ (current_buffer, selective_display)) > 0 && (BEG_UNCHANGED < start || GPT <= start)) unchanged_p = 0; @@ -11126,8 +11126,8 @@ text_outside_line_unchanged_p (struct window *w, require to redisplay the whole paragraph. It might be worthwhile to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization. */ - if (!NILP (XBUFFER (w->buffer)->bidi_display_reordering) - && NILP (XBUFFER (w->buffer)->bidi_paragraph_direction)) + if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (B_ (XBUFFER (w->buffer), bidi_paragraph_direction))) unchanged_p = 0; } @@ -11662,11 +11662,11 @@ redisplay_internal (int preserve_echo_area) the whole window. The assignment to this_line_start_pos prevents the optimization directly below this if-statement. */ if (((!NILP (Vtransient_mark_mode) - && !NILP (XBUFFER (w->buffer)->mark_active)) + && !NILP (B_ (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing)) || (!NILP (w->region_showing) && !EQ (w->region_showing, - Fmarker_position (XBUFFER (w->buffer)->mark)))) + Fmarker_position (B_ (XBUFFER (w->buffer), mark))))) CHARPOS (this_line_start_pos) = 0; /* Optimize the case that only the line containing the cursor in the @@ -11826,8 +11826,8 @@ redisplay_internal (int preserve_echo_area) /* If highlighting the region, or if the cursor is in the echo area, then we can't just move the cursor. */ else if (! (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) - && (EQ (selected_window, current_buffer->last_selected_window) + && !NILP (B_ (current_buffer, mark_active))) + && (EQ (selected_window, B_ (current_buffer, last_selected_window)) || highlight_nonselected_windows) && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) @@ -13033,8 +13033,8 @@ try_scrolling (Lisp_Object window, int just_this_one_p, scroll_max = (max (scroll_step, max (arg_scroll_conservatively, temp_scroll_step)) * FRAME_LINE_HEIGHT (f)); - else if (NUMBERP (current_buffer->scroll_down_aggressively) - || NUMBERP (current_buffer->scroll_up_aggressively)) + else if (NUMBERP (B_ (current_buffer, scroll_down_aggressively)) + || NUMBERP (B_ (current_buffer, scroll_up_aggressively))) /* We're trying to scroll because of aggressive scrolling but no scroll_step is set. Choose an arbitrary one. */ scroll_max = 10 * FRAME_LINE_HEIGHT (f); @@ -13099,7 +13099,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, amount_to_scroll = scroll_max; else { - aggressive = current_buffer->scroll_up_aggressively; + aggressive = B_ (current_buffer, scroll_up_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); if (NUMBERP (aggressive)) { @@ -13182,7 +13182,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, amount_to_scroll = scroll_max; else { - aggressive = current_buffer->scroll_down_aggressively; + aggressive = B_ (current_buffer, scroll_down_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); if (NUMBERP (aggressive)) { @@ -13363,7 +13363,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste region exists, cursor movement has to do more than just set the cursor. */ && !(!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (B_ (current_buffer, mark_active))) && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) /* Right after splitting windows, last_point may be nil. */ @@ -13518,7 +13518,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste must_scroll = 1; } else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + && !NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) { /* If rows are bidi-reordered and point moved, back up until we find a row that does not belong to a @@ -13576,7 +13576,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste else if (scroll_p) rc = CURSOR_MOVEMENT_MUST_SCROLL; else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + && !NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) { /* With bidi-reordered rows, there could be more than one candidate row whose start and end positions @@ -13876,7 +13876,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) struct Lisp_Char_Table *disptab = buffer_display_table (); if (! disptab_matches_widthtab (disptab, - XVECTOR (current_buffer->width_table))) + XVECTOR (B_ (current_buffer, width_table)))) { invalidate_region_cache (current_buffer, current_buffer->width_run_cache, @@ -13998,7 +13998,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) /* If we are highlighting the region, then we just changed the region, so redisplay to show it. */ if (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (B_ (current_buffer, mark_active))) { clear_glyph_matrix (w->desired_matrix); if (!try_window (window, startp, 0)) @@ -14161,8 +14161,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p) if ((scroll_conservatively || emacs_scroll_step || temp_scroll_step - || NUMBERP (current_buffer->scroll_up_aggressively) - || NUMBERP (current_buffer->scroll_down_aggressively)) + || NUMBERP (B_ (current_buffer, scroll_up_aggressively)) + || NUMBERP (B_ (current_buffer, scroll_down_aggressively))) && !current_buffer->clip_changed && CHARPOS (startp) >= BEGV && CHARPOS (startp) <= ZV) @@ -14605,7 +14605,7 @@ try_window_reusing_current_matrix (struct window *w) /* Can't do this if region may have changed. */ if ((!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (B_ (current_buffer, mark_active))) || !NILP (w->region_showing) || !NILP (Vshow_trailing_whitespace)) return 0; @@ -14948,7 +14948,7 @@ try_window_reusing_current_matrix (struct window *w) /* Can't use this optimization with bidi-reordered glyph rows, unless cursor is already at point. */ - if (!NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) { if (!(w->cursor.hpos >= 0 && w->cursor.hpos < row->used[TEXT_AREA] @@ -15262,7 +15262,7 @@ row_containing_pos (struct window *w, EMACS_INT charpos, { struct glyph *g; - if (NILP (XBUFFER (w->buffer)->bidi_display_reordering) + if (NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) || (!best_row && !row->continued_p)) return row; /* In bidi-reordered rows, there could be several rows @@ -15409,7 +15409,7 @@ try_window_id (struct window *w) /* Can't use this if highlighting a region because a cursor movement will do more than just set the cursor. */ if (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (B_ (current_buffer, mark_active))) GIVE_UP (9); /* Likewise if highlighting trailing whitespace. */ @@ -15429,7 +15429,7 @@ try_window_id (struct window *w) wrapped line can change the wrap position, altering the line above it. It might be worthwhile to handle this more intelligently, but for now just redisplay from scratch. */ - if (!NILP (XBUFFER (w->buffer)->word_wrap)) + if (!NILP (B_ (XBUFFER (w->buffer), word_wrap))) GIVE_UP (21); /* Under bidi reordering, adding or deleting a character in the @@ -15440,8 +15440,8 @@ try_window_id (struct window *w) to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization and redisplay from scratch. */ - if (!NILP (XBUFFER (w->buffer)->bidi_display_reordering) - && NILP (XBUFFER (w->buffer)->bidi_paragraph_direction)) + if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (B_ (XBUFFER (w->buffer), bidi_paragraph_direction))) GIVE_UP (22); /* Make sure beg_unchanged and end_unchanged are up to date. Do it @@ -16412,7 +16412,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) it.glyph_row->used[TEXT_AREA] = 0; SET_TEXT_POS (it.position, 0, 0); - multibyte_p = !NILP (buffer->enable_multibyte_characters); + multibyte_p = !NILP (B_ (buffer, enable_multibyte_characters)); p = arrow_string; while (p < arrow_end) { @@ -17347,7 +17347,7 @@ display_line (struct it *it) row->glyphs[TEXT_AREA]->charpos = -1; row->displays_text_p = 0; - if (!NILP (XBUFFER (it->w->buffer)->indicate_empty_lines) + if (!NILP (B_ (XBUFFER (it->w->buffer), indicate_empty_lines)) && (!MINI_WINDOW_P (it->w) || (minibuf_level && EQ (it->window, minibuf_window)))) row->indicate_empty_line_p = 1; @@ -17925,10 +17925,10 @@ See also `bidi-paragraph-direction'. */) old = current_buffer; } - if (NILP (buf->bidi_display_reordering)) + if (NILP (B_ (buf, bidi_display_reordering))) return Qleft_to_right; - else if (!NILP (buf->bidi_paragraph_direction)) - return buf->bidi_paragraph_direction; + else if (!NILP (B_ (buf, bidi_paragraph_direction))) + return B_ (buf, bidi_paragraph_direction); else { /* Determine the direction from buffer text. We could try to @@ -18187,14 +18187,14 @@ display_mode_lines (struct window *w) /* Select mode line face based on the real selected window. */ display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), - current_buffer->mode_line_format); + B_ (current_buffer, mode_line_format)); ++n; } if (WINDOW_WANTS_HEADER_LINE_P (w)) { display_mode_line (w, HEADER_LINE_FACE_ID, - current_buffer->header_line_format); + B_ (current_buffer, header_line_format)); ++n; } @@ -19129,7 +19129,7 @@ static char * decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_flag) { Lisp_Object val; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); const unsigned char *eol_str; int eol_str_len; /* The EOL conversion we are using. */ @@ -19225,7 +19225,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, switch (c) { case '*': - if (!NILP (b->read_only)) + if (!NILP (B_ (b, read_only))) return "%"; if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; @@ -19235,7 +19235,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, /* This differs from %* only for a modified read-only buffer. */ if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; - if (!NILP (b->read_only)) + if (!NILP (B_ (b, read_only))) return "%"; return "-"; @@ -19297,7 +19297,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, } case 'b': - obj = b->name; + obj = B_ (b, name); break; case 'c': @@ -19337,7 +19337,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, return "Emacs"; case 'f': - obj = b->filename; + obj = B_ (b, filename); break; case 'i': @@ -19473,7 +19473,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, break; case 'm': - obj = b->mode_name; + obj = B_ (b, mode_name); break; case 'n': @@ -19558,7 +19558,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, { int count = inhibit_garbage_collection (); Lisp_Object val = call1 (intern ("file-remote-p"), - current_buffer->directory); + B_ (current_buffer, directory)); unbind_to (count, Qnil); if (NILP (val)) @@ -19593,7 +19593,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, (FRAME_TERMINAL_CODING (f)->id), p, 0); } - p = decode_mode_spec_coding (b->buffer_file_coding_system, + p = decode_mode_spec_coding (B_ (b, buffer_file_coding_system), p, eol_flag); #if 0 /* This proves to be annoying; I think we can do without. -- rms. */ @@ -19643,8 +19643,8 @@ display_count_lines (EMACS_INT start, EMACS_INT start_byte, /* If we are not in selective display mode, check only for newlines. */ - int selective_display = (!NILP (current_buffer->selective_display) - && !INTEGERP (current_buffer->selective_display)); + int selective_display = (!NILP (B_ (current_buffer, selective_display)) + && !INTEGERP (B_ (current_buffer, selective_display))); if (count > 0) { @@ -23291,13 +23291,13 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, { if (w == XWINDOW (echo_area_window)) { - if (EQ (b->cursor_type, Qt) || NILP (b->cursor_type)) + if (EQ (B_ (b, cursor_type), Qt) || NILP (B_ (b, cursor_type))) { *width = FRAME_CURSOR_WIDTH (f); return FRAME_DESIRED_CURSOR (f); } else - return get_specified_cursor_type (b->cursor_type, width); + return get_specified_cursor_type (B_ (b, cursor_type), width); } *active_cursor = 0; @@ -23317,23 +23317,23 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, } /* Never display a cursor in a window in which cursor-type is nil. */ - if (NILP (b->cursor_type)) + if (NILP (B_ (b, cursor_type))) return NO_CURSOR; /* Get the normal cursor type for this window. */ - if (EQ (b->cursor_type, Qt)) + if (EQ (B_ (b, cursor_type), Qt)) { cursor_type = FRAME_DESIRED_CURSOR (f); *width = FRAME_CURSOR_WIDTH (f); } else - cursor_type = get_specified_cursor_type (b->cursor_type, width); + cursor_type = get_specified_cursor_type (B_ (b, cursor_type), width); /* Use cursor-in-non-selected-windows instead for non-selected window or frame. */ if (non_selected) { - alt_cursor = b->cursor_in_non_selected_windows; + alt_cursor = B_ (b, cursor_in_non_selected_windows); if (!EQ (Qt, alt_cursor)) return get_specified_cursor_type (alt_cursor, width); /* t means modify the normal cursor type. */ @@ -23380,7 +23380,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, /* Cursor is blinked off, so determine how to "toggle" it. */ /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ - if ((alt_cursor = Fassoc (b->cursor_type, Vblink_cursor_alist), !NILP (alt_cursor))) + if ((alt_cursor = Fassoc (B_ (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) return get_specified_cursor_type (XCDR (alt_cursor), width); /* Then see if frame has specified a specific blink off cursor type. */ @@ -25496,11 +25496,11 @@ note_mouse_highlight (struct frame *f, int x, int y) necessarily display the character whose position is the smallest. */ Lisp_Object lim1 = - NILP (XBUFFER (buffer)->bidi_display_reordering) + NILP (B_ (XBUFFER (buffer), bidi_display_reordering)) ? Fmarker_position (w->start) : Qnil; Lisp_Object lim2 = - NILP (XBUFFER (buffer)->bidi_display_reordering) + NILP (B_ (XBUFFER (buffer), bidi_display_reordering)) ? make_number (BUF_Z (XBUFFER (buffer)) - XFASTINT (w->window_end_pos)) : Qnil; diff --git a/src/xfaces.c b/src/xfaces.c index 82ad0b9aeb6..9ae35a74bd1 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -5970,7 +5970,7 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop) { int face_id; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (B_ (current_buffer, enable_multibyte_characters))) ch = 0; if (NILP (prop)) diff --git a/src/xfns.c b/src/xfns.c index ce2d91e0df1..062bb105d0a 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4610,7 +4610,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - current_buffer->truncate_lines = Qnil; + B_ (current_buffer, truncate_lines) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5106,7 +5106,7 @@ Text larger than the specified size is clipped. */) /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); - current_buffer->truncate_lines = Qnil; + B_ (current_buffer, truncate_lines) = Qnil; clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); diff --git a/src/xmenu.c b/src/xmenu.c index ad1a764eab8..934db0f0406 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -887,31 +887,26 @@ apply_systemfont_to_dialog (Widget w) { XrmDatabase db = XtDatabase (XtDisplay (w)); if (db) - XrmPutStringResource (&db, "*dialog.faceName", fn); + XrmPutStringResource (&db, "*dialog.font", fn); } } static void -apply_systemfont_to_menu (Widget w) +apply_systemfont_to_menu (struct frame *f, Widget w) { const char *fn = xsettings_get_system_normal_font (); - int defflt; - if (!fn) return; - - if (XtIsShell (w)) /* popup menu */ + if (fn) { - Widget *childs = NULL; - - XtVaGetValues (w, XtNchildren, &childs, NULL); - if (*childs) w = *childs; + XrmDatabase db = XtDatabase (XtDisplay (w)); + if (db) + { + XrmPutStringResource (&db, "*menubar*font", fn); + XrmPutStringResource (&db, "*popup*font", fn); + } } - - /* Only use system font if the default is used for the menu. */ - XtVaGetValues (w, XtNdefaultFace, &defflt, NULL); - if (defflt) - XtVaSetValues (w, XtNfaceName, fn, NULL); } + #endif /* Set the contents of the menubar widgets of frame F. @@ -1210,7 +1205,11 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()"; XtTranslations override = XtParseTranslationTable (menuOverride); - menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv, +#ifdef USE_LUCID + apply_systemfont_to_menu (f, f->output_data.x->column_widget); +#endif + menubar_widget = lw_create_widget ("menubar", "menubar", id, + first_wv, f->output_data.x->column_widget, 0, popup_activate_callback, @@ -1221,9 +1220,6 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) /* Make menu pop down on C-g. */ XtOverrideTranslations (menubar_widget, override); -#ifdef USE_LUCID - apply_systemfont_to_menu (menubar_widget); -#endif } { @@ -1542,6 +1538,10 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, if (! FRAME_X_P (f)) abort (); +#ifdef USE_LUCID + apply_systemfont_to_menu (f, f->output_data.x->widget); +#endif + menu_id = widget_id_tick++; menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv, f->output_data.x->widget, 1, 0, @@ -1549,10 +1549,6 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, popup_deactivate_callback, menu_highlight_callback); -#ifdef USE_LUCID - apply_systemfont_to_menu (menu); -#endif - dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; diff --git a/src/xrdb.c b/src/xrdb.c index 90afe32bb66..01714900752 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -546,12 +546,14 @@ x_load_resources (Display *display, const char *xrm_string, #else /* not USE_MOTIF */ - sprintf (line, "Emacs.dialog*.font: %s", helv); - XrmPutLineResource (&rdb, line); sprintf (line, "Emacs.dialog*.background: grey75"); XrmPutLineResource (&rdb, line); +#if !defined (HAVE_XFT) || !defined (USE_LUCID) + sprintf (line, "Emacs.dialog*.font: %s", helv); + XrmPutLineResource (&rdb, line); sprintf (line, "*XlwMenu*font: %s", helv); XrmPutLineResource (&rdb, line); +#endif sprintf (line, "*XlwMenu*background: grey75"); XrmPutLineResource (&rdb, line); sprintf (line, "Emacs*verticalScrollBar.background: grey75"); diff --git a/test/ChangeLog b/test/ChangeLog index 3f2dbec1e55..8c7cd6f5b13 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2011-02-14 Chong Yidong <cyd@stupidchicken.com> + + * automated/bytecomp-tests.el: Move from bytecomp-testsuite.el; + convert to ERT format. + 2011-02-09 Stefan Monnier <monnier@iro.umontreal.ca> * indent/shell.sh: diff --git a/test/bytecomp-testsuite.el b/test/automated/bytecomp-tests.el index 2a8bba52182..45d5b19ee71 100644 --- a/test/bytecomp-testsuite.el +++ b/test/automated/bytecomp-tests.el @@ -24,6 +24,8 @@ ;;; Commentary: +(require 'ert) + ;;; Code: (defconst byte-opt-testsuite-arith-data '( @@ -34,7 +36,8 @@ (let ((a 3) (b 2) (c 1.0)) (/ a b c)) (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (+ a -1 b)) (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (- a 1 (- b))) - (let ((a (expt 2 -1074)) (b 0.125)) (* a 8 b)) + ;; This fails. Should it be a bug? + ;; (let ((a (expt 2 -1074)) (b 0.125)) (* a 8 b)) (let ((a 1.0)) (* a 0)) (let ((a 1.0)) (* a 2.0 0)) (let ((a 1.0)) (/ 0 a)) @@ -241,42 +244,71 @@ (let ((a 3) (b 2) (c 1.0)) (/ a b c -1))) "List of expression for test. Each element will be executed by interpreter and with -bytecompiled code, and their results are compared.") +bytecompiled code, and their results compared.") + +(defun bytecomp-check-1 (pat) + "Return non-nil if PAT is the same whether directly evalled or compiled." + (let ((warning-minimum-log-level :emergency) + (byte-compile-warnings nil) + (v0 (condition-case nil + (eval pat) + (error nil))) + (v1 (condition-case nil + (funcall (byte-compile (list 'lambda nil pat))) + (error nil)))) + (equal v0 v1))) +(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) -(defun bytecomp-testsuite-run () - "Run bytecomp test suite." - (interactive) - (with-output-to-temp-buffer "*bytecomp test*" - (byte-opt-testsuite--run-arith) - (message "All byte-opt tests finished successfully."))) +(defun bytecomp-explain-1 (pat) + (let ((v0 (condition-case nil + (eval pat) + (error nil))) + (v1 (condition-case nil + (funcall (byte-compile (list 'lambda nil pat))) + (error nil)))) + (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." + pat v0 v1))) +(ert-deftest bytecomp-tests () + "Test the Emacs byte compiler." + (dolist (pat byte-opt-testsuite-arith-data) + (should (bytecomp-check-1 pat)))) -(defun byte-opt-testsuite--run-arith (&optional arg) +(defun test-byte-opt-arithmetic (&optional arg) "Unit test for byte-opt arithmetic operations. Subtests signal errors if something goes wrong." (interactive "P") - (let ((print-escape-nonascii t) + (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) + (let ((warning-minimum-log-level :emergency) + (byte-compile-warnings nil) + (pass-face '((t :foreground "green"))) + (fail-face '((t :foreground "red"))) + (print-escape-nonascii t) (print-escape-newlines t) (print-quoted t) - v0 v1 - indent-tabs-mode - (patterns byte-opt-testsuite-arith-data)) - (mapc - (lambda (pat) - (condition-case nil - (setq v0 (eval pat)) - (error (setq v0 nil))) - (condition-case nil - (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 nil))) - (princ (format "%s" pat)) - (if (equal v0 v1) - (princ (format " --> %s, OK\n" v1)) - (princ (format " --> %s, NG\n" v0)) - (princ (format " --> %s\n" v1)) - (error "Arithmetic test failed!"))) - patterns))) + v0 v1) + (dolist (pat byte-opt-testsuite-arith-data) + (condition-case nil + (setq v0 (eval pat)) + (error (setq v0 nil))) + (condition-case nil + (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) + (error (setq v1 nil))) + (insert (format "%s" pat)) + (indent-to-column 65) + (if (equal v0 v1) + (insert (propertize "OK" 'face pass-face)) + (insert (propertize "FAIL\n" 'face fail-face)) + (indent-to-column 55) + (insert (propertize (format "[%s] vs [%s]" v0 v1) + 'face fail-face))) + (insert "\n")))) + + +;; Local Variables: +;; no-byte-compile: t +;; End: (provide 'byte-opt-testsuite) diff --git a/test/automated/font-parse-tests.el b/test/automated/font-parse-tests.el index 5fc0f6c604f..463d0f98bb3 100644 --- a/test/automated/font-parse-tests.el +++ b/test/automated/font-parse-tests.el @@ -25,8 +25,6 @@ ;; Type M-x test-font-parse RET to generate the test buffer. -;; TODO: Convert to ERT format. - ;;; Code: (require 'ert) |