diff options
| author | Paul Eggert | 2011-02-17 23:44:39 -0800 |
|---|---|---|
| committer | Paul Eggert | 2011-02-17 23:44:39 -0800 |
| commit | 37b3d30244ad822e049b6b20c2eadf5946cb02cc (patch) | |
| tree | 49bfe5e475aee761975f2618be4ee1b7c8371a72 | |
| parent | 0ca2f89e09202a02f392c1defba2105b69c01419 (diff) | |
| parent | 7d315eb67800796d7d7f39030eb7682340d985e5 (diff) | |
| download | emacs-37b3d30244ad822e049b6b20c2eadf5946cb02cc.tar.gz emacs-37b3d30244ad822e049b6b20c2eadf5946cb02cc.zip | |
Merge from mainline.
139 files changed, 7382 insertions, 1833 deletions
| @@ -1,3 +1,8 @@ | |||
| 1 | 2011-02-18 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Import IRIX 6.5 getloadavg fixes from gnulib. | ||
| 4 | * configure, lib/getloadavg.c, m4/getloadavg.m4: Regenerate. | ||
| 5 | |||
| 1 | 2011-02-16 Paul Eggert <eggert@cs.ucla.edu> | 6 | 2011-02-16 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 7 | ||
| 3 | Import getloadavg module from gnulib. | 8 | Import getloadavg module from gnulib. |
| @@ -14475,6 +14475,8 @@ test -f "$srcdir/$gl_source_base/getloadavg.c" || | |||
| 14475 | 14475 | ||
| 14476 | gl_save_LIBS=$LIBS | 14476 | gl_save_LIBS=$LIBS |
| 14477 | 14477 | ||
| 14478 | # getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, | ||
| 14479 | # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. | ||
| 14478 | ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" | 14480 | ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" |
| 14479 | if test "x$ac_cv_func_getloadavg" = xyes; then : | 14481 | if test "x$ac_cv_func_getloadavg" = xyes; then : |
| 14480 | 14482 | ||
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 34096144066..c075f1785d3 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog | |||
| @@ -1,3 +1,26 @@ | |||
| 1 | 2011-02-17 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 2 | |||
| 3 | * auth.texi (Help for users): Use :port instead of :protocol for all | ||
| 4 | auth-source docs. | ||
| 5 | (GnuPG and EasyPG Assistant Configuration): Mention the default now is | ||
| 6 | to have two files in `auth-sources'. | ||
| 7 | |||
| 8 | 2011-02-16 Glenn Morris <rgm@gnu.org> | ||
| 9 | |||
| 10 | * dired-x.texi: Use emacsver.texi to get Emacs version. | ||
| 11 | * Makefile.in ($(infodir)/dired-x, dired-x.dvi, dired-x.pdf): | ||
| 12 | Depend on emacsver.texi. | ||
| 13 | |||
| 14 | * dired-x.texi: Drop meaningless version number. | ||
| 15 | (Introduction): Remove old info. | ||
| 16 | (Optional Installation Dired Jump): Autoload from dired-x. | ||
| 17 | Remove incorrect info about loaddefs.el. | ||
| 18 | (Bugs): Just refer to M-x report-emacs-bug. | ||
| 19 | |||
| 20 | * dired-x.texi (Multiple Dired Directories): Update for rename of | ||
| 21 | default-directory-alist. | ||
| 22 | (Miscellaneous Commands): No longer mention very old VM version 4. | ||
| 23 | |||
| 1 | 2011-02-15 Paul Eggert <eggert@cs.ucla.edu> | 24 | 2011-02-15 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 25 | ||
| 3 | Merge from gnulib. | 26 | Merge from gnulib. |
| @@ -5,7 +28,8 @@ | |||
| 5 | 28 | ||
| 6 | 2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> | 29 | 2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> |
| 7 | 30 | ||
| 8 | * auth.texi (Help for users): Login collection is "Login" and not "login". | 31 | * auth.texi (Help for users): |
| 32 | Login collection is "Login" and not "login". | ||
| 9 | 33 | ||
| 10 | 2011-02-13 Michael Albinus <michael.albinus@gmx.de> | 34 | 2011-02-13 Michael Albinus <michael.albinus@gmx.de> |
| 11 | 35 | ||
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 169d6c89b85..0a28d417c70 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in | |||
| @@ -287,12 +287,12 @@ dbus.pdf: ${srcdir}/dbus.texi | |||
| 287 | $(ENVADD) $(TEXI2PDF) $< | 287 | $(ENVADD) $(TEXI2PDF) $< |
| 288 | 288 | ||
| 289 | dired-x : $(infodir)/dired-x | 289 | dired-x : $(infodir)/dired-x |
| 290 | $(infodir)/dired-x: dired-x.texi | 290 | $(infodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi |
| 291 | $(mkinfodir) | 291 | $(mkinfodir) |
| 292 | cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $< | 292 | cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $< |
| 293 | dired-x.dvi: ${srcdir}/dired-x.texi | 293 | dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi |
| 294 | $(ENVADD) $(TEXI2DVI) $< | 294 | $(ENVADD) $(TEXI2DVI) $< |
| 295 | dired-x.pdf: ${srcdir}/dired-x.texi | 295 | dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi |
| 296 | $(ENVADD) $(TEXI2PDF) $< | 296 | $(ENVADD) $(TEXI2PDF) $< |
| 297 | 297 | ||
| 298 | ebrowse : $(infodir)/ebrowse | 298 | ebrowse : $(infodir)/ebrowse |
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 020c582305c..67f5b52b694 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi | |||
| @@ -105,8 +105,7 @@ It's known as @var{:host} in @code{auth-source-search} queries. You | |||
| 105 | can also use @code{host}. | 105 | can also use @code{host}. |
| 106 | 106 | ||
| 107 | The @code{port} is the connection port or protocol. It's known as | 107 | The @code{port} is the connection port or protocol. It's known as |
| 108 | @var{:port} in @code{auth-source-search} queries. You can also use | 108 | @var{:port} in @code{auth-source-search} queries. |
| 109 | @code{protocol}. | ||
| 110 | 109 | ||
| 111 | The @code{user} is the user name. It's known as @var{:user} in | 110 | The @code{user} is the user name. It's known as @var{:user} in |
| 112 | @code{auth-source-search} queries. You can also use @code{login} and | 111 | @code{auth-source-search} queries. You can also use @code{login} and |
| @@ -155,8 +154,8 @@ particular host and protocol. While you can get fancy, the default | |||
| 155 | and simplest configuration is: | 154 | and simplest configuration is: |
| 156 | 155 | ||
| 157 | @lisp | 156 | @lisp |
| 158 | ;;; old default: required :host and :protocol, not needed anymore | 157 | ;;; old default: required :host and :port, not needed anymore |
| 159 | (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) | 158 | (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t))) |
| 160 | ;;; mostly equivalent (see below about fallbacks) but shorter: | 159 | ;;; mostly equivalent (see below about fallbacks) but shorter: |
| 161 | (setq auth-sources '((:source "~/.authinfo.gpg"))) | 160 | (setq auth-sources '((:source "~/.authinfo.gpg"))) |
| 162 | ;;; even shorter and the @emph{default}: | 161 | ;;; even shorter and the @emph{default}: |
| @@ -263,7 +262,9 @@ TODO: how to include docstring? | |||
| 263 | @appendix GnuPG and EasyPG Assistant Configuration | 262 | @appendix GnuPG and EasyPG Assistant Configuration |
| 264 | 263 | ||
| 265 | If you don't customize @code{auth-sources}, the auth-source library | 264 | If you don't customize @code{auth-sources}, the auth-source library |
| 266 | reads @code{~/.authinfo.gpg}, which is a GnuPG encrypted file. | 265 | reads @code{~/.authinfo.gpg}, which is a GnuPG encrypted file. Then |
| 266 | it will check @code{~/.authinfo} but it's not recommended to use such | ||
| 267 | an unencrypted file. | ||
| 267 | 268 | ||
| 268 | In Emacs 23 or later there is an option @code{auto-encryption-mode} to | 269 | In Emacs 23 or later there is an option @code{auto-encryption-mode} to |
| 269 | automatically decrypt @code{*.gpg} files. It is enabled by default. | 270 | automatically decrypt @code{*.gpg} files. It is enabled by default. |
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 9ae569c151c..c16858beffd 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi | |||
| @@ -7,10 +7,11 @@ | |||
| 7 | @c [Dodd's address no longer valid.] | 7 | @c [Dodd's address no longer valid.] |
| 8 | 8 | ||
| 9 | @comment %**start of header (This is for running Texinfo on a region.) | 9 | @comment %**start of header (This is for running Texinfo on a region.) |
| 10 | @c FOR GNU EMACS USE ../info/dired-x BELOW | ||
| 11 | @setfilename ../../info/dired-x | 10 | @setfilename ../../info/dired-x |
| 12 | @c dired-x.el REVISION NUMBER | 11 | @settitle Dired Extra User's Manual |
| 13 | @settitle Dired Extra Version 2 User's Manual | 12 | |
| 13 | @include emacsver.texi | ||
| 14 | |||
| 14 | @iftex | 15 | @iftex |
| 15 | @finalout | 16 | @finalout |
| 16 | @end iftex | 17 | @end iftex |
| @@ -18,7 +19,8 @@ | |||
| 18 | @comment %**end of header (This is for running Texinfo on a region.) | 19 | @comment %**end of header (This is for running Texinfo on a region.) |
| 19 | 20 | ||
| 20 | @copying | 21 | @copying |
| 21 | Copyright @copyright{} 1994-1995, 1999, 2001-2011 Free Software Foundation, Inc. | 22 | Copyright @copyright{} 1994-1995, 1999, 2001-2011 |
| 23 | Free Software Foundation, Inc. | ||
| 22 | 24 | ||
| 23 | @quotation | 25 | @quotation |
| 24 | Permission is granted to copy, distribute and/or modify this document | 26 | Permission is granted to copy, distribute and/or modify this document |
| @@ -47,8 +49,7 @@ developing GNU and promoting software freedom.'' | |||
| 47 | 49 | ||
| 48 | @titlepage | 50 | @titlepage |
| 49 | @sp 6 | 51 | @sp 6 |
| 50 | @c dired-x.el REVISION NUMBER | 52 | @center @titlefont{Dired Extra} |
| 51 | @center @titlefont{Dired Extra Version 2} | ||
| 52 | @sp 2 | 53 | @sp 2 |
| 53 | @center @titlefont{For The GNU Emacs} | 54 | @center @titlefont{For The GNU Emacs} |
| 54 | @sp 1 | 55 | @sp 1 |
| @@ -70,10 +71,9 @@ developing GNU and promoting software freedom.'' | |||
| 70 | 71 | ||
| 71 | @node Top | 72 | @node Top |
| 72 | @top Dired Extra | 73 | @top Dired Extra |
| 73 | @comment node-name, next, previous, up | ||
| 74 | 74 | ||
| 75 | @noindent | 75 | @noindent |
| 76 | This documents the ``extra'' features for Dired Mode for GNU Emacs that are | 76 | This documents the ``extra'' features for GNU Emacs's Dired Mode that are |
| 77 | provided by the file @file{dired-x.el}. | 77 | provided by the file @file{dired-x.el}. |
| 78 | 78 | ||
| 79 | @itemize @bullet | 79 | @itemize @bullet |
| @@ -81,20 +81,8 @@ provided by the file @file{dired-x.el}. | |||
| 81 | @item | 81 | @item |
| 82 | Based on @file{dired.texi} by Sebastian Kremer <sk@@thp.uni-koeln.de> | 82 | Based on @file{dired.texi} by Sebastian Kremer <sk@@thp.uni-koeln.de> |
| 83 | 83 | ||
| 84 | @c dired-x.el REVISION NUMBER | ||
| 85 | @item | 84 | @item |
| 86 | For @file{dired-x.el} revision 2 | 85 | For @file{dired-x.el} as distributed with GNU Emacs @value{EMACSVER}. |
| 87 | |||
| 88 | @c @item | ||
| 89 | @c Revision of this manual: 2.53 (2001/02/25 14:05:46) | ||
| 90 | |||
| 91 | @c @item | ||
| 92 | @c Bugs to Lawrence R. Dodd <dodd@@roebling.poly.edu>. @emph{Please} type | ||
| 93 | @c @kbd{M-x dired-x-submit-report} to submit a bug report (@pxref{Bugs}). | ||
| 94 | |||
| 95 | @c @item | ||
| 96 | @c You can obtain a copy of this package via anonymous ftp in | ||
| 97 | @c @t{/roebling.poly.edu:/pub/packages/dired-x.tar.gz} | ||
| 98 | 86 | ||
| 99 | @end itemize | 87 | @end itemize |
| 100 | 88 | ||
| @@ -124,19 +112,11 @@ For @file{dired-x.el} revision 2 | |||
| 124 | @end ifnottex | 112 | @end ifnottex |
| 125 | 113 | ||
| 126 | @node Introduction, Installation, Top, Top | 114 | @node Introduction, Installation, Top, Top |
| 127 | @comment node-name, next, previous, up | ||
| 128 | @chapter Introduction | 115 | @chapter Introduction |
| 129 | 116 | ||
| 130 | This documents the @emph{extra} features for Dired Mode for GNU Emacs. It | 117 | This documents some @emph{extra} features for GNU Emacs's Dired Mode |
| 131 | is derived from version 1.191 of Sebastian Kremer's @file{dired-x.el}. | 118 | that are provided by @file{dired-x.el} (derived from Sebastian Kremer's |
| 132 | 119 | original @file{dired-x.el}). | |
| 133 | In adopting this @file{dired-x.el} to GNU Emacs v19 some material that has | ||
| 134 | been incorporated into @file{dired.el} and @file{dired-aux.el} of the GNU Emacs | ||
| 135 | 19 distribution has been removed and some material was modified for agreement | ||
| 136 | with the functions in @file{dired.el} and @file{dired-aux.el}. For example, | ||
| 137 | the code using @code{gmhist} history functions was replaced with code using | ||
| 138 | the mini-buffer history now built into GNU Emacs. Finally, a few other | ||
| 139 | features have been added and a few more functions have been bound to keys. | ||
| 140 | 120 | ||
| 141 | @ifnottex | 121 | @ifnottex |
| 142 | @menu | 122 | @menu |
| @@ -146,7 +126,6 @@ features have been added and a few more functions have been bound to keys. | |||
| 146 | @end ifnottex | 126 | @end ifnottex |
| 147 | 127 | ||
| 148 | @node Features, Technical Details, , Introduction | 128 | @node Features, Technical Details, , Introduction |
| 149 | @comment node-name, next, previous, up | ||
| 150 | @section Features | 129 | @section Features |
| 151 | @cindex Features | 130 | @cindex Features |
| 152 | 131 | ||
| @@ -194,7 +173,6 @@ C-f} and @kbd{C-x 4 C-f} to @code{dired-x-find-file} and | |||
| 194 | Point}). | 173 | Point}). |
| 195 | 174 | ||
| 196 | @node Technical Details, , Features, Introduction | 175 | @node Technical Details, , Features, Introduction |
| 197 | @comment node-name, next, previous, up | ||
| 198 | @section Technical Details | 176 | @section Technical Details |
| 199 | @cindex Redefined functions | 177 | @cindex Redefined functions |
| 200 | @cindex @file{dired-aux.el} | 178 | @cindex @file{dired-aux.el} |
| @@ -222,7 +200,6 @@ and the following functions from @file{dired-aux.el} | |||
| 222 | @end itemize | 200 | @end itemize |
| 223 | 201 | ||
| 224 | @node Installation, Omitting Files in Dired, Introduction, Top | 202 | @node Installation, Omitting Files in Dired, Introduction, Top |
| 225 | @comment node-name, next, previous, up | ||
| 226 | @chapter Installation | 203 | @chapter Installation |
| 227 | 204 | ||
| 228 | @noindent | 205 | @noindent |
| @@ -231,8 +208,8 @@ This manual describes the Dired features provided by the file | |||
| 231 | file and (optionally) set some variables. | 208 | file and (optionally) set some variables. |
| 232 | 209 | ||
| 233 | @noindent | 210 | @noindent |
| 234 | In your @file{.emacs} file in your home directory, or in the system-wide | 211 | In your @file{~/.emacs} file, or in the system-wide initialization file |
| 235 | initialization file @file{default.el} in the @file{site-lisp} directory, put | 212 | @file{default.el} in the @file{site-lisp} directory, put |
| 236 | 213 | ||
| 237 | @example | 214 | @example |
| 238 | (add-hook 'dired-load-hook | 215 | (add-hook 'dired-load-hook |
| @@ -261,48 +238,27 @@ when you first type @kbd{C-x d}). | |||
| 261 | @end ifnottex | 238 | @end ifnottex |
| 262 | 239 | ||
| 263 | @node Optional Installation Dired Jump, Optional Installation File At Point, , Installation | 240 | @node Optional Installation Dired Jump, Optional Installation File At Point, , Installation |
| 264 | @comment node-name, next, previous, up | ||
| 265 | @section Optional Installation Dired Jump | 241 | @section Optional Installation Dired Jump |
| 266 | 242 | ||
| 267 | @cindex Autoloading @code{dired-jump} and @code{dired-jump-other-window} | 243 | @cindex Autoloading @code{dired-jump} and @code{dired-jump-other-window} |
| 268 | 244 | ||
| 269 | In order to have @code{dired-jump} and @code{dired-jump-other-window} | 245 | In order to have @code{dired-jump} and @code{dired-jump-other-window} |
| 270 | (@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and | 246 | (@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and |
| 271 | @code{dired-x} have been properly loaded the user should set-up an autoload | 247 | @code{dired-x} have been properly loaded you should set-up an autoload |
| 272 | for these functions. In your @file{.emacs} file put | 248 | for these functions. In your @file{.emacs} file put |
| 273 | 249 | ||
| 274 | @example | 250 | @example |
| 275 | ;; Autoload `dired-jump' and `dired-jump-other-window'. | 251 | (autoload 'dired-jump "dired-x" |
| 276 | ;; We autoload from FILE dired.el. This will then load dired-x.el | 252 | "Jump to Dired buffer corresponding to current buffer." t) |
| 277 | ;; and hence define `dired-jump' and `dired-jump-other-window'. | ||
| 278 | (define-key global-map "\C-x\C-j" 'dired-jump) | ||
| 279 | (define-key global-map "\C-x4\C-j" 'dired-jump-other-window) | ||
| 280 | |||
| 281 | (autoload (quote dired-jump) "dired" "\ | ||
| 282 | Jump to Dired buffer corresponding to current buffer. | ||
| 283 | If in a file, Dired the current directory and move to file's line. | ||
| 284 | If in Dired already, pop up a level and goto old directory's line. | ||
| 285 | In case the proper Dired file line cannot be found, refresh the Dired | ||
| 286 | buffer and try again." t nil) | ||
| 287 | |||
| 288 | (autoload (quote dired-jump-other-window) "dired" "\ | ||
| 289 | Like \\[dired-jump] (dired-jump) but in other window." t nil) | ||
| 290 | @end example | ||
| 291 | 253 | ||
| 292 | Note that in recent releases of GNU Emacs 19 (i.e., 19.25 or later) the file | 254 | (autoload 'dired-jump-other-window "dired-x" |
| 293 | @file{../lisp/loaddefs.el} of the Emacs distribution already contains the | 255 | "Like \\[dired-jump] (dired-jump) but in other window." t) |
| 294 | proper auto-loading for @code{dired-jump} so you need only put | ||
| 295 | 256 | ||
| 296 | @example | ||
| 297 | (define-key global-map "\C-x\C-j" 'dired-jump) | 257 | (define-key global-map "\C-x\C-j" 'dired-jump) |
| 258 | (define-key global-map "\C-x4\C-j" 'dired-jump-other-window) | ||
| 298 | @end example | 259 | @end example |
| 299 | 260 | ||
| 300 | @noindent | ||
| 301 | in your @file{.emacs} file in order to have @kbd{C-x C-j} work | ||
| 302 | before @code{dired} is loaded. | ||
| 303 | |||
| 304 | @node Optional Installation File At Point, , Optional Installation Dired Jump, Installation | 261 | @node Optional Installation File At Point, , Optional Installation Dired Jump, Installation |
| 305 | @comment node-name, next, previous, up | ||
| 306 | @section Optional Installation File At Point | 262 | @section Optional Installation File At Point |
| 307 | 263 | ||
| 308 | @cindex Binding @code{dired-x-find-file} | 264 | @cindex Binding @code{dired-x-find-file} |
| @@ -335,7 +291,6 @@ loaded | |||
| 335 | @end example | 291 | @end example |
| 336 | 292 | ||
| 337 | @node Omitting Files in Dired, Local Variables, Installation, Top | 293 | @node Omitting Files in Dired, Local Variables, Installation, Top |
| 338 | @comment node-name, next, previous, up | ||
| 339 | @chapter Omitting Files in Dired | 294 | @chapter Omitting Files in Dired |
| 340 | 295 | ||
| 341 | @cindex Omitting Files in Dired | 296 | @cindex Omitting Files in Dired |
| @@ -392,8 +347,6 @@ inside @code{dired-load-hook} (@pxref{Installation}) and then evaluate | |||
| 392 | @end ifnottex | 347 | @end ifnottex |
| 393 | 348 | ||
| 394 | @node Omitting Variables, Omitting Examples, , Omitting Files in Dired | 349 | @node Omitting Variables, Omitting Examples, , Omitting Files in Dired |
| 395 | @comment node-name, next, previous, up | ||
| 396 | |||
| 397 | @section Omitting Variables | 350 | @section Omitting Variables |
| 398 | 351 | ||
| 399 | @cindex Customizing file omitting | 352 | @cindex Customizing file omitting |
| @@ -501,7 +454,6 @@ will show up again after reverting the buffer, unlike the others. | |||
| 501 | @end table | 454 | @end table |
| 502 | 455 | ||
| 503 | @node Omitting Examples, Omitting Technical, Omitting Variables, Omitting Files in Dired | 456 | @node Omitting Examples, Omitting Technical, Omitting Variables, Omitting Files in Dired |
| 504 | @comment node-name, next, previous, up | ||
| 505 | @section Examples of Omitting Various File Types | 457 | @section Examples of Omitting Various File Types |
| 506 | 458 | ||
| 507 | @itemize @bullet | 459 | @itemize @bullet |
| @@ -555,7 +507,6 @@ in the @code{dired-load-hook} (@pxref{Installation}). | |||
| 555 | @end itemize | 507 | @end itemize |
| 556 | 508 | ||
| 557 | @node Omitting Technical, , Omitting Examples, Omitting Files in Dired | 509 | @node Omitting Technical, , Omitting Examples, Omitting Files in Dired |
| 558 | @comment node-name, next, previous, up | ||
| 559 | @section Some Technical Details of Omitting | 510 | @section Some Technical Details of Omitting |
| 560 | 511 | ||
| 561 | Loading @file{dired-x.el} will install Dired Omit by putting | 512 | Loading @file{dired-x.el} will install Dired Omit by putting |
| @@ -563,8 +514,8 @@ Loading @file{dired-x.el} will install Dired Omit by putting | |||
| 563 | call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup} | 514 | call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup} |
| 564 | in your @code{dired-mode-hook}. | 515 | in your @code{dired-mode-hook}. |
| 565 | 516 | ||
| 517 | @c FIXME does the standard dir-locals mechanism obsolete this? | ||
| 566 | @node Local Variables, Shell Command Guessing, Omitting Files in Dired, Top | 518 | @node Local Variables, Shell Command Guessing, Omitting Files in Dired, Top |
| 567 | @comment node-name, next, previous, up | ||
| 568 | @chapter Local Variables for Dired Directories | 519 | @chapter Local Variables for Dired Directories |
| 569 | 520 | ||
| 570 | @cindex Local Variables for Dired Directories | 521 | @cindex Local Variables for Dired Directories |
| @@ -633,7 +584,6 @@ Variables are hacked. | |||
| 633 | @end table | 584 | @end table |
| 634 | 585 | ||
| 635 | @node Shell Command Guessing, Virtual Dired, Local Variables, Top | 586 | @node Shell Command Guessing, Virtual Dired, Local Variables, Top |
| 636 | @comment node-name, next, previous, up | ||
| 637 | @chapter Shell Command Guessing | 587 | @chapter Shell Command Guessing |
| 638 | @cindex Guessing shell commands for files. | 588 | @cindex Guessing shell commands for files. |
| 639 | 589 | ||
| @@ -740,7 +690,6 @@ History list for commands that read dired-shell commands. | |||
| 740 | @end table | 690 | @end table |
| 741 | 691 | ||
| 742 | @node Virtual Dired, Advanced Mark Commands, Shell Command Guessing, Top | 692 | @node Virtual Dired, Advanced Mark Commands, Shell Command Guessing, Top |
| 743 | @comment node-name, next, previous, up | ||
| 744 | @chapter Virtual Dired | 693 | @chapter Virtual Dired |
| 745 | 694 | ||
| 746 | @cindex Virtual Dired | 695 | @cindex Virtual Dired |
| @@ -782,7 +731,6 @@ The regexp is a bit more complicated than usual to exclude @file{.dired} | |||
| 782 | local-variable files. | 731 | local-variable files. |
| 783 | 732 | ||
| 784 | @node Advanced Mark Commands, Multiple Dired Directories, Virtual Dired, Top | 733 | @node Advanced Mark Commands, Multiple Dired Directories, Virtual Dired, Top |
| 785 | @comment node-name, next, previous, up | ||
| 786 | @chapter Advanced Mark Commands | 734 | @chapter Advanced Mark Commands |
| 787 | 735 | ||
| 788 | @table @kbd | 736 | @table @kbd |
| @@ -829,8 +777,6 @@ Flag all files with a certain extension for deletion. A @samp{.} is | |||
| 829 | @end ifnottex | 777 | @end ifnottex |
| 830 | 778 | ||
| 831 | @node Advanced Cleaning Functions, Advanced Cleaning Variables, , Advanced Mark Commands | 779 | @node Advanced Cleaning Functions, Advanced Cleaning Variables, , Advanced Mark Commands |
| 832 | @comment node-name, next, previous, up | ||
| 833 | |||
| 834 | @section Advanced Cleaning Functions | 780 | @section Advanced Cleaning Functions |
| 835 | 781 | ||
| 836 | @table @code | 782 | @table @code |
| @@ -862,8 +808,6 @@ and @file{*.dvi} files for deletion. | |||
| 862 | @end table | 808 | @end table |
| 863 | 809 | ||
| 864 | @node Advanced Cleaning Variables, Special Marking Function, Advanced Cleaning Functions, Advanced Mark Commands | 810 | @node Advanced Cleaning Variables, Special Marking Function, Advanced Cleaning Functions, Advanced Mark Commands |
| 865 | @comment node-name, next, previous, up | ||
| 866 | |||
| 867 | @section Advanced Cleaning Variables | 811 | @section Advanced Cleaning Variables |
| 868 | 812 | ||
| 869 | @noindent Variables used by the above cleaning commands (and in the default value for | 813 | @noindent Variables used by the above cleaning commands (and in the default value for |
| @@ -903,8 +847,6 @@ List of extensions of dispensable files created by Bib@TeX{}. | |||
| 903 | @end table | 847 | @end table |
| 904 | 848 | ||
| 905 | @node Special Marking Function, , Advanced Cleaning Variables, Advanced Mark Commands | 849 | @node Special Marking Function, , Advanced Cleaning Variables, Advanced Mark Commands |
| 906 | @comment node-name, next, previous, up | ||
| 907 | |||
| 908 | @section Special Marking Function | 850 | @section Special Marking Function |
| 909 | 851 | ||
| 910 | @table @kbd | 852 | @table @kbd |
| @@ -961,7 +903,6 @@ to mark all @file{.el} files without a corresponding @file{.elc} file. | |||
| 961 | @end table | 903 | @end table |
| 962 | 904 | ||
| 963 | @node Multiple Dired Directories, Find File At Point, Advanced Mark Commands, Top | 905 | @node Multiple Dired Directories, Find File At Point, Advanced Mark Commands, Top |
| 964 | @comment node-name, next, previous, up | ||
| 965 | @chapter Multiple Dired Directories and Non-Dired Commands | 906 | @chapter Multiple Dired Directories and Non-Dired Commands |
| 966 | 907 | ||
| 967 | @cindex Multiple Dired directories | 908 | @cindex Multiple Dired directories |
| @@ -978,8 +919,8 @@ A general mechanism is provided for special handling of the working | |||
| 978 | directory in special major modes: | 919 | directory in special major modes: |
| 979 | 920 | ||
| 980 | @table @code | 921 | @table @code |
| 981 | @item default-directory-alist | 922 | @item dired-default-directory-alist |
| 982 | @vindex default-directory-alist | 923 | @vindex dired-default-directory-alist |
| 983 | Default: @code{((dired-mode . (dired-current-directory)))} | 924 | Default: @code{((dired-mode . (dired-current-directory)))} |
| 984 | 925 | ||
| 985 | Alist of major modes and their notion of @code{default-directory}, as a | 926 | Alist of major modes and their notion of @code{default-directory}, as a |
| @@ -990,12 +931,10 @@ in favor of @code{default-directory}. | |||
| 990 | @findex dired-default-directory | 931 | @findex dired-default-directory |
| 991 | Use this function like you would use the variable | 932 | Use this function like you would use the variable |
| 992 | @code{default-directory}, except that @code{dired-default-directory} | 933 | @code{default-directory}, except that @code{dired-default-directory} |
| 993 | also consults the variable @code{default-directory-alist}. | 934 | also consults the variable @code{dired-default-directory-alist}. |
| 994 | @end table | 935 | @end table |
| 995 | 936 | ||
| 996 | @node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top | 937 | @node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top |
| 997 | @comment node-name, next, previous, up | ||
| 998 | |||
| 999 | @section Find File At Point | 938 | @section Find File At Point |
| 1000 | @cindex Visiting a file mentioned in a buffer | 939 | @cindex Visiting a file mentioned in a buffer |
| 1001 | @cindex Finding a file at point | 940 | @cindex Finding a file at point |
| @@ -1072,7 +1011,6 @@ that uses the value of @code{dired-x-hands-off-my-keys} to determine if | |||
| 1072 | @end table | 1011 | @end table |
| 1073 | 1012 | ||
| 1074 | @node Miscellaneous Commands, Bugs, Find File At Point, Top | 1013 | @node Miscellaneous Commands, Bugs, Find File At Point, Top |
| 1075 | @comment node-name, next, previous, up | ||
| 1076 | @chapter Miscellaneous Commands | 1014 | @chapter Miscellaneous Commands |
| 1077 | 1015 | ||
| 1078 | Miscellaneous features not fitting anywhere else: | 1016 | Miscellaneous features not fitting anywhere else: |
| @@ -1141,13 +1079,12 @@ file (assumed to be a UNIX mail folder). | |||
| 1141 | 1079 | ||
| 1142 | @vindex dired-vm-read-only-folders | 1080 | @vindex dired-vm-read-only-folders |
| 1143 | If you give this command a prefix argument, it will visit the folder | 1081 | If you give this command a prefix argument, it will visit the folder |
| 1144 | read-only. This only works in VM 5, not VM 4. | 1082 | read-only. |
| 1145 | 1083 | ||
| 1146 | If the variable @code{dired-vm-read-only-folders} is @code{t}, | 1084 | If the variable @code{dired-vm-read-only-folders} is @code{t}, |
| 1147 | @code{dired-vm} will | 1085 | @code{dired-vm} will visit all folders read-only. If it is neither |
| 1148 | visit all folders read-only. If it is neither @code{nil} nor @code{t}, e.g., | 1086 | @code{nil} nor @code{t}, e.g., the symbol @code{if-file-read-only}, only |
| 1149 | the symbol @code{if-file-read-only}, only files not writable by you are | 1087 | files not writable by you are visited read-only. |
| 1150 | visited read-only. This is the recommended value if you run VM 5. | ||
| 1151 | 1088 | ||
| 1152 | @vindex dired-bind-vm | 1089 | @vindex dired-bind-vm |
| 1153 | If the variable @code{dired-bind-vm} is @code{t}, @code{dired-vm} will be bound | 1090 | If the variable @code{dired-bind-vm} is @code{t}, @code{dired-vm} will be bound |
| @@ -1210,50 +1147,30 @@ info. | |||
| 1210 | @end table | 1147 | @end table |
| 1211 | 1148 | ||
| 1212 | @node Bugs, GNU Free Documentation License, Miscellaneous Commands, Top | 1149 | @node Bugs, GNU Free Documentation License, Miscellaneous Commands, Top |
| 1213 | @comment node-name, next, previous, up | ||
| 1214 | @chapter Bugs | 1150 | @chapter Bugs |
| 1215 | @cindex Bugs | 1151 | @cindex Bugs |
| 1216 | @findex dired-x-submit-report | ||
| 1217 | 1152 | ||
| 1218 | @noindent | 1153 | @noindent |
| 1219 | If you encounter a bug in this package, wish to suggest an | 1154 | If you encounter a bug in this package, or wish to suggest an |
| 1220 | enhancement, or want to make a smart remark, then type | 1155 | enhancement, then please use @kbd{M-x report-emacs-bug} to report it. |
| 1221 | |||
| 1222 | @example | ||
| 1223 | @kbd{M-x dired-x-submit-report} | ||
| 1224 | @end example | ||
| 1225 | |||
| 1226 | @noindent | ||
| 1227 | to set up an outgoing mail buffer, with the proper address to the | ||
| 1228 | @file{dired-x.el} maintainer automatically inserted in the @samp{To:@:} field. | ||
| 1229 | This command also inserts information that the Dired X maintainer can use to | ||
| 1230 | recreate your exact setup, making it easier to verify your bug or social | ||
| 1231 | maladjustment. | ||
| 1232 | |||
| 1233 | Lawrence R. Dodd | ||
| 1234 | @c <dodd@@roebling.poly.edu> | ||
| 1235 | 1156 | ||
| 1236 | @node GNU Free Documentation License, Concept Index, Bugs, Top | 1157 | @node GNU Free Documentation License, Concept Index, Bugs, Top |
| 1237 | @appendix GNU Free Documentation License | 1158 | @appendix GNU Free Documentation License |
| 1238 | @include doclicense.texi | 1159 | @include doclicense.texi |
| 1239 | 1160 | ||
| 1240 | @node Concept Index, Command Index, GNU Free Documentation License, Top | 1161 | @node Concept Index, Command Index, GNU Free Documentation License, Top |
| 1241 | @comment node-name, next, previous, up | ||
| 1242 | @unnumbered Concept Index | 1162 | @unnumbered Concept Index |
| 1243 | @printindex cp | 1163 | @printindex cp |
| 1244 | 1164 | ||
| 1245 | @node Command Index, Key Index, Concept Index, Top | 1165 | @node Command Index, Key Index, Concept Index, Top |
| 1246 | @comment node-name, next, previous, up | ||
| 1247 | @unnumbered Function Index | 1166 | @unnumbered Function Index |
| 1248 | @printindex fn | 1167 | @printindex fn |
| 1249 | 1168 | ||
| 1250 | @node Key Index, Variable Index, Command Index, Top | 1169 | @node Key Index, Variable Index, Command Index, Top |
| 1251 | @comment node-name, next, previous, up | ||
| 1252 | @unnumbered Key Index | 1170 | @unnumbered Key Index |
| 1253 | @printindex ky | 1171 | @printindex ky |
| 1254 | 1172 | ||
| 1255 | @node Variable Index, , Key Index, Top | 1173 | @node Variable Index, , Key Index, Top |
| 1256 | @comment node-name, next, previous, up | ||
| 1257 | @unnumbered Variable Index | 1174 | @unnumbered Variable Index |
| 1258 | @printindex vr | 1175 | @printindex vr |
| 1259 | 1176 | ||
diff --git a/etc/ChangeLog b/etc/ChangeLog index 520a12ba15f..ac6ac7df00e 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog | |||
| @@ -1,3 +1,24 @@ | |||
| 1 | 2011-02-17 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 2 | |||
| 3 | * etc/images/icons/allout-widgets/dark-bg, | ||
| 4 | etc/images/icons/allout-widgets/light-bg, | ||
| 5 | encrypted-locked.{xpm,png}, unlocked-encrypted.{xpm,png}: | ||
| 6 | Reorganize icon directories and files to reconcile against windows | ||
| 7 | short-filename clashes. | ||
| 8 | |||
| 9 | 2011-02-16 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 10 | |||
| 11 | * etc/images/icons/allout-widgets-dark-bg, | ||
| 12 | etc/images/icons/allout-widgets-light-bg: Icons for new | ||
| 13 | allout-widgets.el. | ||
| 14 | |||
| 15 | * etc/images/icons/README: Include coypright and GPL 3 license for | ||
| 16 | new icons. | ||
| 17 | |||
| 18 | 2011-02-16 Michael Albinus <michael.albinus@gmx.de> | ||
| 19 | |||
| 20 | * NEWS: Add soap-client.el and soap-inspect.el. | ||
| 21 | |||
| 1 | 2011-02-13 Michael Albinus <michael.albinus@gmx.de> | 22 | 2011-02-13 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 23 | ||
| 3 | * NEWS: Tramp methods "imap" and "imaps" are discontinued. | 24 | * NEWS: Tramp methods "imap" and "imaps" are discontinued. |
| @@ -639,6 +639,9 @@ secrets. | |||
| 639 | ** notifications.el provides an implementation of the Desktop | 639 | ** notifications.el provides an implementation of the Desktop |
| 640 | Notifications API. It requires D-Bus for communication. | 640 | Notifications API. It requires D-Bus for communication. |
| 641 | 641 | ||
| 642 | ** soap-client.el supports access to SOAP web services from Emacs. | ||
| 643 | soap-inspect.el is an interactive inspector for SOAP WSDL structures. | ||
| 644 | |||
| 642 | 645 | ||
| 643 | * Incompatible Lisp Changes in Emacs 24.1 | 646 | * Incompatible Lisp Changes in Emacs 24.1 |
| 644 | 647 | ||
diff --git a/etc/images/icons/README b/etc/images/icons/README index 7855f401bb1..b11b88781e8 100644 --- a/etc/images/icons/README +++ b/etc/images/icons/README | |||
| @@ -15,3 +15,52 @@ Files: hicolor/16x16/apps/emacs22.png hicolor/24x24/apps/emacs22.png | |||
| 15 | Author: Andrew Zhilin <andrew_zhilin@yahoo.com> | 15 | Author: Andrew Zhilin <andrew_zhilin@yahoo.com> |
| 16 | Copyright (C) 2005-2011 Free Software Foundation, Inc. | 16 | Copyright (C) 2005-2011 Free Software Foundation, Inc. |
| 17 | License: GNU General Public License version 3 or later (see COPYING) | 17 | License: GNU General Public License version 3 or later (see COPYING) |
| 18 | |||
| 19 | Files: allout-widgets-dark-bg/closed.png | ||
| 20 | allout-widgets-dark-bg/closed.xpm | ||
| 21 | allout-widgets-dark-bg/empty.png | ||
| 22 | allout-widgets-dark-bg/empty.xpm | ||
| 23 | allout-widgets-dark-bg/encrypted-locked.png | ||
| 24 | allout-widgets-dark-bg/encrypted-locked.xpm | ||
| 25 | allout-widgets-dark-bg/encrypted-unlocked.png | ||
| 26 | allout-widgets-dark-bg/encrypted-unlocked.xpm | ||
| 27 | allout-widgets-dark-bg/end-connector.png | ||
| 28 | allout-widgets-dark-bg/end-connector.xpm | ||
| 29 | allout-widgets-dark-bg/extender-connector.png | ||
| 30 | allout-widgets-dark-bg/extender-connector.xpm | ||
| 31 | allout-widgets-dark-bg/leaf.png | ||
| 32 | allout-widgets-dark-bg/leaf.xpm | ||
| 33 | allout-widgets-dark-bg/mid-connector.png | ||
| 34 | allout-widgets-dark-bg/mid-connector.xpm | ||
| 35 | allout-widgets-dark-bg/opened.png | ||
| 36 | allout-widgets-dark-bg/opened.xpm | ||
| 37 | allout-widgets-dark-bg/skip-descender.png | ||
| 38 | allout-widgets-dark-bg/skip-descender.xpm | ||
| 39 | allout-widgets-dark-bg/through-descender.png | ||
| 40 | allout-widgets-dark-bg/through-descender.xpm | ||
| 41 | allout-widgets-light-bg/closed.png | ||
| 42 | allout-widgets-light-bg/closed.xpm | ||
| 43 | allout-widgets-light-bg/empty.png | ||
| 44 | allout-widgets-light-bg/empty.xpm | ||
| 45 | allout-widgets-light-bg/encrypted-locked.png | ||
| 46 | allout-widgets-light-bg/encrypted-locked.xpm | ||
| 47 | allout-widgets-light-bg/encrypted-unlocked.png | ||
| 48 | allout-widgets-light-bg/encrypted-unlocked.xpm | ||
| 49 | allout-widgets-light-bg/end-connector.png | ||
| 50 | allout-widgets-light-bg/end-connector.xpm | ||
| 51 | allout-widgets-light-bg/extender-connector.png | ||
| 52 | allout-widgets-light-bg/extender-connector.xpm | ||
| 53 | allout-widgets-light-bg/leaf.png | ||
| 54 | allout-widgets-light-bg/leaf.xpm | ||
| 55 | allout-widgets-light-bg/mid-connector.png | ||
| 56 | allout-widgets-light-bg/mid-connector.xpm | ||
| 57 | allout-widgets-light-bg/opened.png | ||
| 58 | allout-widgets-light-bg/opened.xpm | ||
| 59 | allout-widgets-light-bg/skip-descender.png | ||
| 60 | allout-widgets-light-bg/skip-descender.xpm | ||
| 61 | allout-widgets-light-bg/through-descender.png | ||
| 62 | allout-widgets-light-bg/through-descender.xpm | ||
| 63 | |||
| 64 | Author: Ken Manheimer <ken.manheimer@gmail.com> | ||
| 65 | Copyright (C) 2011 Free Software Foundation, Inc. | ||
| 66 | License: GNU General Public License version 3 or later (see COPYING) | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/closed.png b/etc/images/icons/allout-widgets/dark-bg/closed.png new file mode 100644 index 00000000000..b49fd4ad6c9 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/closed.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/closed.xpm b/etc/images/icons/allout-widgets/dark-bg/closed.xpm new file mode 100644 index 00000000000..4d7bbebe21c --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/closed.xpm | |||
| @@ -0,0 +1,30 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "9 17 10 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #000080", | ||
| 6 | "h c #52a55a", | ||
| 7 | "g c #52ad52", | ||
| 8 | "e c #5ab54a", | ||
| 9 | "d c #5abd42", | ||
| 10 | "c c #63c639", | ||
| 11 | "b c #63ce31", | ||
| 12 | "f c #ada5c6", | ||
| 13 | "a c #ffff00", | ||
| 14 | ".........", | ||
| 15 | ".........", | ||
| 16 | ".........", | ||
| 17 | "######...", | ||
| 18 | "aaaaaa#..", | ||
| 19 | ".bbcdaa#.", | ||
| 20 | ".###deaa#", | ||
| 21 | "..ff##gaa", | ||
| 22 | "fffff##ha", | ||
| 23 | "..ff##haa", | ||
| 24 | ".###ghaa#", | ||
| 25 | ".eeggaa#.", | ||
| 26 | "aaaaaa#..", | ||
| 27 | "######...", | ||
| 28 | ".........", | ||
| 29 | ".........", | ||
| 30 | "........."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/empty.png b/etc/images/icons/allout-widgets/dark-bg/empty.png new file mode 100644 index 00000000000..b9675fdb9ba --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/empty.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/empty.xpm b/etc/images/icons/allout-widgets/dark-bg/empty.xpm new file mode 100644 index 00000000000..e0fc8e5701f --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/empty.xpm | |||
| @@ -0,0 +1,29 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 9 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #000080", | ||
| 6 | "f c #52a55a", | ||
| 7 | "g c #52ad52", | ||
| 8 | "d c #5abd42", | ||
| 9 | "b c #63c639", | ||
| 10 | "c c #6bd629", | ||
| 11 | "e c #ada5c6", | ||
| 12 | "a c #ffff00", | ||
| 13 | "..........", | ||
| 14 | "..........", | ||
| 15 | "..........", | ||
| 16 | "...######.", | ||
| 17 | "..#aaaaaa.", | ||
| 18 | ".#aabbbb..", | ||
| 19 | "#aabc###..", | ||
| 20 | "aad##ee...", | ||
| 21 | "adeeeee...", | ||
| 22 | "aad##ee...", | ||
| 23 | "#aafg###..", | ||
| 24 | ".#aabbbb..", | ||
| 25 | "..#aaaaaa.", | ||
| 26 | "...######.", | ||
| 27 | "..........", | ||
| 28 | "..........", | ||
| 29 | ".........."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/end-connector.png b/etc/images/icons/allout-widgets/dark-bg/end-connector.png new file mode 100644 index 00000000000..696c17ea9a9 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/end-connector.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/end-connector.xpm b/etc/images/icons/allout-widgets/dark-bg/end-connector.xpm new file mode 100644 index 00000000000..511d3a4015c --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/end-connector.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #ada5c6", | ||
| 6 | "....#......", | ||
| 7 | "....#......", | ||
| 8 | "....#......", | ||
| 9 | "....#......", | ||
| 10 | "....#......", | ||
| 11 | "....#......", | ||
| 12 | "....#......", | ||
| 13 | "....##.....", | ||
| 14 | ".....######", | ||
| 15 | "...........", | ||
| 16 | "...........", | ||
| 17 | "...........", | ||
| 18 | "...........", | ||
| 19 | "...........", | ||
| 20 | "...........", | ||
| 21 | "...........", | ||
| 22 | "..........."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/extender-connector.png b/etc/images/icons/allout-widgets/dark-bg/extender-connector.png new file mode 100644 index 00000000000..8559f4884d0 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/extender-connector.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/extender-connector.xpm b/etc/images/icons/allout-widgets/dark-bg/extender-connector.xpm new file mode 100644 index 00000000000..cd9ecc4c5f2 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/extender-connector.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #ada5c6", | ||
| 6 | "...........", | ||
| 7 | "...........", | ||
| 8 | "...........", | ||
| 9 | "...........", | ||
| 10 | "...........", | ||
| 11 | "...........", | ||
| 12 | "...........", | ||
| 13 | "...........", | ||
| 14 | "###########", | ||
| 15 | "...........", | ||
| 16 | "...........", | ||
| 17 | "...........", | ||
| 18 | "...........", | ||
| 19 | "...........", | ||
| 20 | "...........", | ||
| 21 | "...........", | ||
| 22 | "..........."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/leaf.png b/etc/images/icons/allout-widgets/dark-bg/leaf.png new file mode 100644 index 00000000000..e2d7b189e84 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/leaf.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/leaf.xpm b/etc/images/icons/allout-widgets/dark-bg/leaf.xpm new file mode 100644 index 00000000000..f25bf40a258 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/leaf.xpm | |||
| @@ -0,0 +1,33 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "16 21 9 1", | ||
| 4 | ". c None", | ||
| 5 | "a c #737373", | ||
| 6 | "b c #7b7b7b", | ||
| 7 | "# c #808080", | ||
| 8 | "c c #848484", | ||
| 9 | "d c #8c8c8c", | ||
| 10 | "e c #949494", | ||
| 11 | "f c #9c9c9c", | ||
| 12 | "g c #a5a5a5", | ||
| 13 | "................", | ||
| 14 | "................", | ||
| 15 | "................", | ||
| 16 | "................", | ||
| 17 | "................", | ||
| 18 | "................", | ||
| 19 | "...#####........", | ||
| 20 | "..#abbcc#.......", | ||
| 21 | ".#abbccdd#......", | ||
| 22 | "#abbccddee#.....", | ||
| 23 | "#bbccddeef#.....", | ||
| 24 | "#bccddeefg#.....", | ||
| 25 | ".#cddeefg#......", | ||
| 26 | "..#deefg#.......", | ||
| 27 | "...#####........", | ||
| 28 | "................", | ||
| 29 | "................", | ||
| 30 | "................", | ||
| 31 | "................", | ||
| 32 | "................", | ||
| 33 | "................"}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.png b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.png new file mode 100644 index 00000000000..a6bc3e99a7a --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.xpm b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.xpm new file mode 100644 index 00000000000..bf7556f2ed9 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.xpm | |||
| @@ -0,0 +1,26 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 6 1", | ||
| 4 | ". c None", | ||
| 5 | "b c #333300", | ||
| 6 | "# c #666600", | ||
| 7 | "d c #808080", | ||
| 8 | "c c #999933", | ||
| 9 | "a c #999966", | ||
| 10 | "..........", | ||
| 11 | "..........", | ||
| 12 | "..........", | ||
| 13 | "..........", | ||
| 14 | "...##a#...", | ||
| 15 | "..aaaaaa..", | ||
| 16 | ".aa....##.", | ||
| 17 | ".ab....a#.", | ||
| 18 | ".cb....#b.", | ||
| 19 | "caaaaaaacb", | ||
| 20 | "cddddddddb", | ||
| 21 | "adaddddddb", | ||
| 22 | "adaddddddb", | ||
| 23 | "caadddddab", | ||
| 24 | "addddddddb", | ||
| 25 | "bbbbbbbbbb", | ||
| 26 | ".........."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/mid-connector.png b/etc/images/icons/allout-widgets/dark-bg/mid-connector.png new file mode 100644 index 00000000000..5ad503ed54d --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/mid-connector.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/mid-connector.xpm b/etc/images/icons/allout-widgets/dark-bg/mid-connector.xpm new file mode 100644 index 00000000000..b583988a220 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/mid-connector.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #ada5c6", | ||
| 6 | "....#......", | ||
| 7 | "....#......", | ||
| 8 | "....#......", | ||
| 9 | "....#......", | ||
| 10 | "....#......", | ||
| 11 | "....#......", | ||
| 12 | "....#......", | ||
| 13 | "....##.....", | ||
| 14 | "....#.#####", | ||
| 15 | "....##.....", | ||
| 16 | "....#......", | ||
| 17 | "....#......", | ||
| 18 | "....#......", | ||
| 19 | "....#......", | ||
| 20 | "....#......", | ||
| 21 | "....#......", | ||
| 22 | "....#......"}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/opened.png b/etc/images/icons/allout-widgets/dark-bg/opened.png new file mode 100644 index 00000000000..5d91d6e8d6d --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/opened.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/opened.xpm b/etc/images/icons/allout-widgets/dark-bg/opened.xpm new file mode 100644 index 00000000000..e86fd9ecf7e --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/opened.xpm | |||
| @@ -0,0 +1,25 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 5 1", | ||
| 4 | ". c None", | ||
| 5 | "a c #000080", | ||
| 6 | "b c #63c639", | ||
| 7 | "c c #ada5c6", | ||
| 8 | "# c #ffff00", | ||
| 9 | "..........", | ||
| 10 | "..........", | ||
| 11 | "..........", | ||
| 12 | "..........", | ||
| 13 | "#.......#a", | ||
| 14 | "#ba...ab#a", | ||
| 15 | "#ba...ab#a", | ||
| 16 | "#bccccab#a", | ||
| 17 | "#bacccab#a", | ||
| 18 | "#bbacabb#a", | ||
| 19 | "##bacab##a", | ||
| 20 | "a##bbb##a.", | ||
| 21 | ".a#####a..", | ||
| 22 | "..a###a...", | ||
| 23 | "...a#a....", | ||
| 24 | "....c.....", | ||
| 25 | "....c....."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/skip-descender.png b/etc/images/icons/allout-widgets/dark-bg/skip-descender.png new file mode 100644 index 00000000000..6e3cb00160f --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/skip-descender.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/skip-descender.xpm b/etc/images/icons/allout-widgets/dark-bg/skip-descender.xpm new file mode 100644 index 00000000000..26ae40d57d5 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/skip-descender.xpm | |||
| @@ -0,0 +1,21 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 1 1", | ||
| 4 | ". c None", | ||
| 5 | "...........", | ||
| 6 | "...........", | ||
| 7 | "...........", | ||
| 8 | "...........", | ||
| 9 | "...........", | ||
| 10 | "...........", | ||
| 11 | "...........", | ||
| 12 | "...........", | ||
| 13 | "...........", | ||
| 14 | "...........", | ||
| 15 | "...........", | ||
| 16 | "...........", | ||
| 17 | "...........", | ||
| 18 | "...........", | ||
| 19 | "...........", | ||
| 20 | "...........", | ||
| 21 | "..........."}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/through-descender.png b/etc/images/icons/allout-widgets/dark-bg/through-descender.png new file mode 100644 index 00000000000..93410e03340 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/through-descender.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/through-descender.xpm b/etc/images/icons/allout-widgets/dark-bg/through-descender.xpm new file mode 100644 index 00000000000..7f375b4fd6c --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/through-descender.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #ada5c6", | ||
| 6 | "....#......", | ||
| 7 | "....#......", | ||
| 8 | "....#......", | ||
| 9 | "....#......", | ||
| 10 | "....#......", | ||
| 11 | "....#......", | ||
| 12 | "....#......", | ||
| 13 | "....#......", | ||
| 14 | "....#......", | ||
| 15 | "....#......", | ||
| 16 | "....#......", | ||
| 17 | "....#......", | ||
| 18 | "....#......", | ||
| 19 | "....#......", | ||
| 20 | "....#......", | ||
| 21 | "....#......", | ||
| 22 | "....#......"}; | ||
diff --git a/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.png b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.png new file mode 100644 index 00000000000..e70d075690a --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm new file mode 100644 index 00000000000..2baa1e81211 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm | |||
| @@ -0,0 +1,26 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 6 1", | ||
| 4 | ". c None", | ||
| 5 | "c c #333300", | ||
| 6 | "a c #666600", | ||
| 7 | "b c #999933", | ||
| 8 | "# c #999966", | ||
| 9 | "d c #ffff00", | ||
| 10 | "..........", | ||
| 11 | "..........", | ||
| 12 | "..........", | ||
| 13 | "...####...", | ||
| 14 | "..#a#a###.", | ||
| 15 | "..a#...##.", | ||
| 16 | ".a#.....#.", | ||
| 17 | ".##.......", | ||
| 18 | "..##......", | ||
| 19 | "b###c###bc", | ||
| 20 | "bddddddddc", | ||
| 21 | "#d#ddddddc", | ||
| 22 | "#d#ddddddc", | ||
| 23 | "b##ddddd#c", | ||
| 24 | "#ddddddddc", | ||
| 25 | "cccccccccc", | ||
| 26 | ".........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/closed.png b/etc/images/icons/allout-widgets/light-bg/closed.png new file mode 100644 index 00000000000..591a11adbb0 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/closed.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/closed.xpm b/etc/images/icons/allout-widgets/light-bg/closed.xpm new file mode 100644 index 00000000000..20710b42822 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/closed.xpm | |||
| @@ -0,0 +1,24 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "9 17 4 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #00ff00", | ||
| 6 | "b c #00ffff", | ||
| 7 | "a c #606060", | ||
| 8 | ".........", | ||
| 9 | ".........", | ||
| 10 | ".........", | ||
| 11 | "######...", | ||
| 12 | "aaaaaa#..", | ||
| 13 | ".bbbbaa#.", | ||
| 14 | "....bbaa#", | ||
| 15 | "..aa..baa", | ||
| 16 | "aaaaa..ba", | ||
| 17 | "..aa..baa", | ||
| 18 | "....bbaa#", | ||
| 19 | ".bbbbaa#.", | ||
| 20 | "aaaaaa#..", | ||
| 21 | "######...", | ||
| 22 | ".........", | ||
| 23 | ".........", | ||
| 24 | "........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/empty.png b/etc/images/icons/allout-widgets/light-bg/empty.png new file mode 100644 index 00000000000..1c02d26ea41 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/empty.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/empty.xpm b/etc/images/icons/allout-widgets/light-bg/empty.xpm new file mode 100644 index 00000000000..0ed70256f3e --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/empty.xpm | |||
| @@ -0,0 +1,24 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 4 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #00ff00", | ||
| 6 | "b c #00ffff", | ||
| 7 | "a c #606060", | ||
| 8 | "..........", | ||
| 9 | "..........", | ||
| 10 | "..........", | ||
| 11 | "...######.", | ||
| 12 | "..#aaaaaa.", | ||
| 13 | ".#aabbbb..", | ||
| 14 | "#aabb.....", | ||
| 15 | "aab..aa...", | ||
| 16 | "abaaaaa...", | ||
| 17 | "aab..aa...", | ||
| 18 | "#aabb.....", | ||
| 19 | ".#aabbbb..", | ||
| 20 | "..#aaaaaa.", | ||
| 21 | "...######.", | ||
| 22 | "..........", | ||
| 23 | "..........", | ||
| 24 | ".........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/end-connector.png b/etc/images/icons/allout-widgets/light-bg/end-connector.png new file mode 100644 index 00000000000..b865b40bfeb --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/end-connector.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/end-connector.xpm b/etc/images/icons/allout-widgets/light-bg/end-connector.xpm new file mode 100644 index 00000000000..0c9c1c7820d --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/end-connector.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #606060", | ||
| 6 | "....#......", | ||
| 7 | "....#......", | ||
| 8 | "....#......", | ||
| 9 | "....#......", | ||
| 10 | "....#......", | ||
| 11 | "....#......", | ||
| 12 | "....#......", | ||
| 13 | "....##.....", | ||
| 14 | ".....######", | ||
| 15 | "...........", | ||
| 16 | "...........", | ||
| 17 | "...........", | ||
| 18 | "...........", | ||
| 19 | "...........", | ||
| 20 | "...........", | ||
| 21 | "...........", | ||
| 22 | "..........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/extender-connector.png b/etc/images/icons/allout-widgets/light-bg/extender-connector.png new file mode 100644 index 00000000000..4023a456776 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/extender-connector.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/extender-connector.xpm b/etc/images/icons/allout-widgets/light-bg/extender-connector.xpm new file mode 100644 index 00000000000..36ea8f93093 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/extender-connector.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #606060", | ||
| 6 | "...........", | ||
| 7 | "...........", | ||
| 8 | "...........", | ||
| 9 | "...........", | ||
| 10 | "...........", | ||
| 11 | "...........", | ||
| 12 | "...........", | ||
| 13 | "...........", | ||
| 14 | "###########", | ||
| 15 | "...........", | ||
| 16 | "...........", | ||
| 17 | "...........", | ||
| 18 | "...........", | ||
| 19 | "...........", | ||
| 20 | "...........", | ||
| 21 | "...........", | ||
| 22 | "..........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/leaf.png b/etc/images/icons/allout-widgets/light-bg/leaf.png new file mode 100755 index 00000000000..e2d7b189e84 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/leaf.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/leaf.xpm b/etc/images/icons/allout-widgets/light-bg/leaf.xpm new file mode 100755 index 00000000000..f25bf40a258 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/leaf.xpm | |||
| @@ -0,0 +1,33 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "16 21 9 1", | ||
| 4 | ". c None", | ||
| 5 | "a c #737373", | ||
| 6 | "b c #7b7b7b", | ||
| 7 | "# c #808080", | ||
| 8 | "c c #848484", | ||
| 9 | "d c #8c8c8c", | ||
| 10 | "e c #949494", | ||
| 11 | "f c #9c9c9c", | ||
| 12 | "g c #a5a5a5", | ||
| 13 | "................", | ||
| 14 | "................", | ||
| 15 | "................", | ||
| 16 | "................", | ||
| 17 | "................", | ||
| 18 | "................", | ||
| 19 | "...#####........", | ||
| 20 | "..#abbcc#.......", | ||
| 21 | ".#abbccdd#......", | ||
| 22 | "#abbccddee#.....", | ||
| 23 | "#bbccddeef#.....", | ||
| 24 | "#bccddeefg#.....", | ||
| 25 | ".#cddeefg#......", | ||
| 26 | "..#deefg#.......", | ||
| 27 | "...#####........", | ||
| 28 | "................", | ||
| 29 | "................", | ||
| 30 | "................", | ||
| 31 | "................", | ||
| 32 | "................", | ||
| 33 | "................"}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/locked-encrypted.png b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.png new file mode 100755 index 00000000000..a6bc3e99a7a --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/locked-encrypted.xpm b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.xpm new file mode 100644 index 00000000000..bf7556f2ed9 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.xpm | |||
| @@ -0,0 +1,26 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 6 1", | ||
| 4 | ". c None", | ||
| 5 | "b c #333300", | ||
| 6 | "# c #666600", | ||
| 7 | "d c #808080", | ||
| 8 | "c c #999933", | ||
| 9 | "a c #999966", | ||
| 10 | "..........", | ||
| 11 | "..........", | ||
| 12 | "..........", | ||
| 13 | "..........", | ||
| 14 | "...##a#...", | ||
| 15 | "..aaaaaa..", | ||
| 16 | ".aa....##.", | ||
| 17 | ".ab....a#.", | ||
| 18 | ".cb....#b.", | ||
| 19 | "caaaaaaacb", | ||
| 20 | "cddddddddb", | ||
| 21 | "adaddddddb", | ||
| 22 | "adaddddddb", | ||
| 23 | "caadddddab", | ||
| 24 | "addddddddb", | ||
| 25 | "bbbbbbbbbb", | ||
| 26 | ".........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/mid-connector.png b/etc/images/icons/allout-widgets/light-bg/mid-connector.png new file mode 100644 index 00000000000..658f340ca80 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/mid-connector.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/mid-connector.xpm b/etc/images/icons/allout-widgets/light-bg/mid-connector.xpm new file mode 100644 index 00000000000..d86f1645c03 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/mid-connector.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #606060", | ||
| 6 | "....#......", | ||
| 7 | "....#......", | ||
| 8 | "....#......", | ||
| 9 | "....#......", | ||
| 10 | "....#......", | ||
| 11 | "....#......", | ||
| 12 | "....#......", | ||
| 13 | "....##.....", | ||
| 14 | "....#.#####", | ||
| 15 | "....##.....", | ||
| 16 | "....#......", | ||
| 17 | "....#......", | ||
| 18 | "....#......", | ||
| 19 | "....#......", | ||
| 20 | "....#......", | ||
| 21 | "....#......", | ||
| 22 | "....#......"}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/opened.png b/etc/images/icons/allout-widgets/light-bg/opened.png new file mode 100644 index 00000000000..2a77830c175 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/opened.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/opened.xpm b/etc/images/icons/allout-widgets/light-bg/opened.xpm new file mode 100644 index 00000000000..ce3e98fea4b --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/opened.xpm | |||
| @@ -0,0 +1,24 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 4 1", | ||
| 4 | ". c None", | ||
| 5 | "a c #00ff00", | ||
| 6 | "b c #00ffff", | ||
| 7 | "# c #606060", | ||
| 8 | "..........", | ||
| 9 | "..........", | ||
| 10 | "..........", | ||
| 11 | "..........", | ||
| 12 | "#.......#a", | ||
| 13 | "#b.....b#a", | ||
| 14 | "#b.....b#a", | ||
| 15 | "#b####.b#a", | ||
| 16 | "#b.###.b#a", | ||
| 17 | "#bb.#.bb#a", | ||
| 18 | "##b.#.b##a", | ||
| 19 | "a##b#b##a.", | ||
| 20 | ".a##b##a..", | ||
| 21 | "..a###a...", | ||
| 22 | "...a#a....", | ||
| 23 | "....#.....", | ||
| 24 | "....#....."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/skip-descender.png b/etc/images/icons/allout-widgets/light-bg/skip-descender.png new file mode 100644 index 00000000000..6e3cb00160f --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/skip-descender.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/skip-descender.xpm b/etc/images/icons/allout-widgets/light-bg/skip-descender.xpm new file mode 100644 index 00000000000..26ae40d57d5 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/skip-descender.xpm | |||
| @@ -0,0 +1,21 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 1 1", | ||
| 4 | ". c None", | ||
| 5 | "...........", | ||
| 6 | "...........", | ||
| 7 | "...........", | ||
| 8 | "...........", | ||
| 9 | "...........", | ||
| 10 | "...........", | ||
| 11 | "...........", | ||
| 12 | "...........", | ||
| 13 | "...........", | ||
| 14 | "...........", | ||
| 15 | "...........", | ||
| 16 | "...........", | ||
| 17 | "...........", | ||
| 18 | "...........", | ||
| 19 | "...........", | ||
| 20 | "...........", | ||
| 21 | "..........."}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/through-descender.png b/etc/images/icons/allout-widgets/light-bg/through-descender.png new file mode 100644 index 00000000000..bdf08b80193 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/through-descender.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/through-descender.xpm b/etc/images/icons/allout-widgets/light-bg/through-descender.xpm new file mode 100644 index 00000000000..d94c6f675c4 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/through-descender.xpm | |||
| @@ -0,0 +1,22 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "11 17 2 1", | ||
| 4 | ". c None", | ||
| 5 | "# c #606060", | ||
| 6 | "....#......", | ||
| 7 | "....#......", | ||
| 8 | "....#......", | ||
| 9 | "....#......", | ||
| 10 | "....#......", | ||
| 11 | "....#......", | ||
| 12 | "....#......", | ||
| 13 | "....#......", | ||
| 14 | "....#......", | ||
| 15 | "....#......", | ||
| 16 | "....#......", | ||
| 17 | "....#......", | ||
| 18 | "....#......", | ||
| 19 | "....#......", | ||
| 20 | "....#......", | ||
| 21 | "....#......", | ||
| 22 | "....#......"}; | ||
diff --git a/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.png b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.png new file mode 100755 index 00000000000..e70d075690a --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.png | |||
| Binary files differ | |||
diff --git a/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm new file mode 100644 index 00000000000..2baa1e81211 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm | |||
| @@ -0,0 +1,26 @@ | |||
| 1 | /* XPM */ | ||
| 2 | static char *dummy[]={ | ||
| 3 | "10 17 6 1", | ||
| 4 | ". c None", | ||
| 5 | "c c #333300", | ||
| 6 | "a c #666600", | ||
| 7 | "b c #999933", | ||
| 8 | "# c #999966", | ||
| 9 | "d c #ffff00", | ||
| 10 | "..........", | ||
| 11 | "..........", | ||
| 12 | "..........", | ||
| 13 | "...####...", | ||
| 14 | "..#a#a###.", | ||
| 15 | "..a#...##.", | ||
| 16 | ".a#.....#.", | ||
| 17 | ".##.......", | ||
| 18 | "..##......", | ||
| 19 | "b###c###bc", | ||
| 20 | "bddddddddc", | ||
| 21 | "#d#ddddddc", | ||
| 22 | "#d#ddddddc", | ||
| 23 | "b##ddddd#c", | ||
| 24 | "#ddddddddc", | ||
| 25 | "cccccccccc", | ||
| 26 | ".........."}; | ||
diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 28e2ea0164b..d324451ef15 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c | |||
| @@ -508,7 +508,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 508 | elem = -1; | 508 | elem = -1; |
| 509 | # endif | 509 | # endif |
| 510 | 510 | ||
| 511 | # if !defined (LDAV_DONE) && defined (HAVE_LIBKSTAT) | 511 | # if !defined (LDAV_DONE) && defined (HAVE_LIBKSTAT) /* Solaris <= 2.6 */ |
| 512 | /* Use libkstat because we don't have to be root. */ | 512 | /* Use libkstat because we don't have to be root. */ |
| 513 | # define LDAV_DONE | 513 | # define LDAV_DONE |
| 514 | kstat_ctl_t *kc; | 514 | kstat_ctl_t *kc; |
| @@ -559,6 +559,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 559 | # endif /* HAVE_LIBKSTAT */ | 559 | # endif /* HAVE_LIBKSTAT */ |
| 560 | 560 | ||
| 561 | # if !defined (LDAV_DONE) && defined (hpux) && defined (HAVE_PSTAT_GETDYNAMIC) | 561 | # if !defined (LDAV_DONE) && defined (hpux) && defined (HAVE_PSTAT_GETDYNAMIC) |
| 562 | /* HP-UX */ | ||
| 562 | /* Use pstat_getdynamic() because we don't have to be root. */ | 563 | /* Use pstat_getdynamic() because we don't have to be root. */ |
| 563 | # define LDAV_DONE | 564 | # define LDAV_DONE |
| 564 | # undef LOAD_AVE_TYPE | 565 | # undef LOAD_AVE_TYPE |
| @@ -575,7 +576,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 575 | 576 | ||
| 576 | # endif /* hpux && HAVE_PSTAT_GETDYNAMIC */ | 577 | # endif /* hpux && HAVE_PSTAT_GETDYNAMIC */ |
| 577 | 578 | ||
| 578 | # if ! defined LDAV_DONE && defined HAVE_LIBPERFSTAT | 579 | # if ! defined LDAV_DONE && defined HAVE_LIBPERFSTAT /* AIX */ |
| 579 | # define LDAV_DONE | 580 | # define LDAV_DONE |
| 580 | # undef LOAD_AVE_TYPE | 581 | # undef LOAD_AVE_TYPE |
| 581 | /* Use perfstat_cpu_total because we don't have to be root. */ | 582 | /* Use perfstat_cpu_total because we don't have to be root. */ |
| @@ -592,6 +593,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 592 | # endif | 593 | # endif |
| 593 | 594 | ||
| 594 | # if !defined (LDAV_DONE) && (defined (__linux__) || defined (__CYGWIN__)) | 595 | # if !defined (LDAV_DONE) && (defined (__linux__) || defined (__CYGWIN__)) |
| 596 | /* Linux without glibc, Cygwin */ | ||
| 595 | # define LDAV_DONE | 597 | # define LDAV_DONE |
| 596 | # undef LOAD_AVE_TYPE | 598 | # undef LOAD_AVE_TYPE |
| 597 | 599 | ||
| @@ -648,7 +650,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 648 | 650 | ||
| 649 | # endif /* __linux__ || __CYGWIN__ */ | 651 | # endif /* __linux__ || __CYGWIN__ */ |
| 650 | 652 | ||
| 651 | # if !defined (LDAV_DONE) && defined (__NetBSD__) | 653 | # if !defined (LDAV_DONE) && defined (__NetBSD__) /* NetBSD < 0.9 */ |
| 652 | # define LDAV_DONE | 654 | # define LDAV_DONE |
| 653 | # undef LOAD_AVE_TYPE | 655 | # undef LOAD_AVE_TYPE |
| 654 | 656 | ||
| @@ -680,7 +682,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 680 | 682 | ||
| 681 | # endif /* __NetBSD__ */ | 683 | # endif /* __NetBSD__ */ |
| 682 | 684 | ||
| 683 | # if !defined (LDAV_DONE) && defined (NeXT) | 685 | # if !defined (LDAV_DONE) && defined (NeXT) /* NeXTStep */ |
| 684 | # define LDAV_DONE | 686 | # define LDAV_DONE |
| 685 | /* The NeXT code was adapted from iscreen 3.2. */ | 687 | /* The NeXT code was adapted from iscreen 3.2. */ |
| 686 | 688 | ||
| @@ -842,6 +844,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 842 | # endif /* OSF_MIPS */ | 844 | # endif /* OSF_MIPS */ |
| 843 | 845 | ||
| 844 | # if !defined (LDAV_DONE) && (defined (__MSDOS__) || defined (WINDOWS32)) | 846 | # if !defined (LDAV_DONE) && (defined (__MSDOS__) || defined (WINDOWS32)) |
| 847 | /* DJGPP */ | ||
| 845 | # define LDAV_DONE | 848 | # define LDAV_DONE |
| 846 | 849 | ||
| 847 | /* A faithful emulation is going to have to be saved for a rainy day. */ | 850 | /* A faithful emulation is going to have to be saved for a rainy day. */ |
| @@ -851,7 +854,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 851 | } | 854 | } |
| 852 | # endif /* __MSDOS__ || WINDOWS32 */ | 855 | # endif /* __MSDOS__ || WINDOWS32 */ |
| 853 | 856 | ||
| 854 | # if !defined (LDAV_DONE) && defined (OSF_ALPHA) | 857 | # if !defined (LDAV_DONE) && defined (OSF_ALPHA) /* OSF/1 */ |
| 855 | # define LDAV_DONE | 858 | # define LDAV_DONE |
| 856 | 859 | ||
| 857 | struct tbl_loadavg load_ave; | 860 | struct tbl_loadavg load_ave; |
| @@ -863,7 +866,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 863 | : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); | 866 | : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); |
| 864 | # endif /* OSF_ALPHA */ | 867 | # endif /* OSF_ALPHA */ |
| 865 | 868 | ||
| 866 | # if ! defined LDAV_DONE && defined __VMS | 869 | # if ! defined LDAV_DONE && defined __VMS /* VMS */ |
| 867 | /* VMS specific code -- read from the Load Ave driver. */ | 870 | /* VMS specific code -- read from the Load Ave driver. */ |
| 868 | 871 | ||
| 869 | LOAD_AVE_TYPE load_ave[3]; | 872 | LOAD_AVE_TYPE load_ave[3]; |
| @@ -907,6 +910,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 907 | # endif /* ! defined LDAV_DONE && defined __VMS */ | 910 | # endif /* ! defined LDAV_DONE && defined __VMS */ |
| 908 | 911 | ||
| 909 | # if ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS | 912 | # if ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS |
| 913 | /* IRIX, other old systems */ | ||
| 910 | 914 | ||
| 911 | /* UNIX-specific code -- read the average from /dev/kmem. */ | 915 | /* UNIX-specific code -- read the average from /dev/kmem. */ |
| 912 | 916 | ||
| @@ -948,9 +952,7 @@ getloadavg (double loadavg[], int nelem) | |||
| 948 | } | 952 | } |
| 949 | # endif /* !SUNOS_5 */ | 953 | # endif /* !SUNOS_5 */ |
| 950 | # else /* sgi */ | 954 | # else /* sgi */ |
| 951 | int ldav_off; | 955 | ptrdiff_t ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); |
| 952 | |||
| 953 | ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); | ||
| 954 | if (ldav_off != -1) | 956 | if (ldav_off != -1) |
| 955 | offset = (long int) ldav_off & 0x7fffffff; | 957 | offset = (long int) ldav_off & 0x7fffffff; |
| 956 | # endif /* sgi */ | 958 | # endif /* sgi */ |
diff --git a/lisp/.gitignore b/lisp/.gitignore index d8ab5055b4a..6d5166e1349 100644 --- a/lisp/.gitignore +++ b/lisp/.gitignore | |||
| @@ -4,5 +4,3 @@ loaddefs.el | |||
| 4 | subdirs.el | 4 | subdirs.el |
| 5 | finder-inf.el | 5 | finder-inf.el |
| 6 | cus-load.el | 6 | cus-load.el |
| 7 | |||
| 8 | # arch-tag: ab6e8f91-fb95-4efe-9c1b-68e21561e68a | ||
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a9adce5a3f5..8e850fb9409 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,129 @@ | |||
| 1 | 2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns. | ||
| 4 | |||
| 5 | 2011-02-18 Christian Ohler <ohler@gnu.org> | ||
| 6 | |||
| 7 | * emacs-lisp/ert.el (ert--setup-results-buffer) | ||
| 8 | (ert-results-pop-to-backtrace-for-test-at-point) | ||
| 9 | (ert-results-pop-to-messages-for-test-at-point) | ||
| 10 | (ert-results-pop-to-should-forms-for-test-at-point) | ||
| 11 | (ert-results-pop-to-timings): Revert parts of change 2011-02-02T17:59:44Z!sds@gnu.org that | ||
| 12 | were incorrect and unnecessary. This should make `make check' | ||
| 13 | pass again. | ||
| 14 | |||
| 15 | 2011-02-17 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 16 | |||
| 17 | * lisp/allout-widgets.el: (allout-widgets-icons-light-subdir) | ||
| 18 | (allout-widgets-icons-dark-subdir): Track relocations of icons | ||
| 19 | * lisp/allout.el: Remove commentary about remove encryption | ||
| 20 | passphrase mnemonic support and verification. | ||
| 21 | (allout-encrypt-string): (allout-encrypt-string): Recognize epg | ||
| 22 | failure to decrypt gpg2 armored text using gpg1, and indicate that | ||
| 23 | the gpg version *might* be the problem in the error message. | ||
| 24 | |||
| 25 | 2011-02-17 Deniz Dogan <deniz.a.m.dogan@gmail.com> | ||
| 26 | |||
| 27 | * net/rcirc.el (rcirc-float-time): New function. | ||
| 28 | (rcirc-keepalive, rcirc-handler-ctcp-KEEPALIVE) | ||
| 29 | (rcirc-ctcp-sender-PING): Use it. | ||
| 30 | |||
| 31 | 2011-02-17 Glenn Morris <rgm@gnu.org> | ||
| 32 | |||
| 33 | * speedbar.el (speedbar-ignored-modes, speedbar-file-unshown-regexp) | ||
| 34 | (speedbar-update-flag, speedbar-fetch-etags-command) | ||
| 35 | (speedbar-fetch-etags-arguments): | ||
| 36 | * term.el (term-buffer-maximum-size, term-input-chunk-size) | ||
| 37 | (term-completion-autolist, term-completion-addsuffix) | ||
| 38 | (term-completion-recexact, term-completion-fignore): | ||
| 39 | * term/sup-mouse.el (sup-mouse-fast-select-window): | ||
| 40 | * term/x-win.el (x-select-request-type): | ||
| 41 | Convert some defvars with "*" to defcustoms. | ||
| 42 | |||
| 43 | * shell.el (shell-delimiter-argument-list): Set it to nil. (Bug#8027) | ||
| 44 | |||
| 45 | * vc/vc.el (vc-default-previous-version): | ||
| 46 | Remove alias that points nowhere. (Bug#4496) | ||
| 47 | |||
| 48 | * dired-x.el (dired-clean-up-after-deletion): | ||
| 49 | kill-buffer does not need save-excursion. | ||
| 50 | (dired-do-run-mail): Doc fix. | ||
| 51 | (dired-filename-at-point): Doc fix. | ||
| 52 | Use looking-at, and skip-chars rather than re search. | ||
| 53 | |||
| 54 | * dired-x.el (dired-filename-at-point): Fix 8-year old typo. | ||
| 55 | |||
| 56 | 2011-02-16 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 57 | |||
| 58 | * allout-widgets.el: New allout extension that shows allout | ||
| 59 | outline structure with graphical widgets. 'allout-widgets' | ||
| 60 | customize group is an 'allout' subgroup, for easy discovery. | ||
| 61 | |||
| 62 | * allout.el: Include PGP and GnuPG in Keywords, and other | ||
| 63 | commentary refinements. | ||
| 64 | (allout-abbreviate-flattened-numbering): Rename to | ||
| 65 | allout-flattened-numbering-abbreviation, and | ||
| 66 | define-obsolete-variable-alias the old name. | ||
| 67 | (allout-flattened-numbering-abbreviation): Rename from | ||
| 68 | allout-abbreviate-flattened-numbering. | ||
| 69 | (allout-mode-p): Include among autoloads, for use by other modes | ||
| 70 | with impunity. | ||
| 71 | (allout-listify-exposed): Use | ||
| 72 | allout-flattened-numbering-abbreviation. | ||
| 73 | (allout-encrypt-string): Use set-buffer-multibyte directly. | ||
| 74 | (allout-set-buffer-multibyte): Remove. | ||
| 75 | |||
| 76 | 2011-02-16 Deniz Dogan <deniz.a.m.dogan@gmail.com> | ||
| 77 | |||
| 78 | * simple.el (just-one-space): Remove useless `or' call. | ||
| 79 | |||
| 80 | 2011-02-16 Alex Harsanyi <AlexHarsanyi@gmail.com> | ||
| 81 | |||
| 82 | * soap-client.el (soap-well-known-xmlns, soap-local-xmlns) | ||
| 83 | (soap-default-xmlns, soap-target-xmlns, soap-multi-refs) | ||
| 84 | (soap-decoded-multi-refs, soap-current-wsdl) | ||
| 85 | (soap-encoded-namespaces): Rename CL-style *...* variables. | ||
| 86 | |||
| 87 | 2011-02-16 Michael Albinus <michael.albinus@gmx.de> | ||
| 88 | |||
| 89 | * net/soap-client.el: Add "comm" and "hypermedia" to the | ||
| 90 | keywords. Reflow too long lines. | ||
| 91 | |||
| 92 | * net/soap-inspect.el: Ditto. Require 'cl. | ||
| 93 | |||
| 94 | 2011-02-16 Bastien Guerry <bzg@altern.org> | ||
| 95 | |||
| 96 | * play/doctor.el (doctor-mode): Bugfix: escape the "," character | ||
| 97 | in a `doctor-type' argument. | ||
| 98 | |||
| 99 | 2011-02-16 Alex Harsanyi <AlexHarsanyi@gmail.com> | ||
| 100 | |||
| 101 | * net/soap-client.el: | ||
| 102 | * net/soap-inspect.el: New files. | ||
| 103 | |||
| 104 | 2011-02-16 Leo <sdl.web@gmail.com> | ||
| 105 | |||
| 106 | * dired-x.el (dired-mode-map, dired-extra-startup): | ||
| 107 | Remove dired-copy-filename-as-kill since it's already in dired.el. | ||
| 108 | |||
| 109 | 2011-02-16 Glenn Morris <rgm@gnu.org> | ||
| 110 | |||
| 111 | * dired-x.el (dired-bind-jump, dired-bind-man, dired-bind-info): | ||
| 112 | Doc fixes. Add :set property, replacing top-level calls. | ||
| 113 | (dired-vm-read-only-folders, dired-vm): Doc fix (drop v. old VM 4). | ||
| 114 | (dired-guess-shell-gnutar): Test tar version rather than system-type. | ||
| 115 | (dired-extra-startup, dired-man, dired-info): Doc fixes. | ||
| 116 | (dired-clean-up-after-deletion): Use when and dolist. | ||
| 117 | (dired-jump): Use unless and when. | ||
| 118 | (dired-virtual): Use line-end-position. | ||
| 119 | (dired-default-directory-alist): Rename from default-directory-alist. | ||
| 120 | (dired-default-directory): Update for above name change. | ||
| 121 | (dired-vm): Drop VM < 5 and simplify. | ||
| 122 | (dired-buffer-more-recently-used-p): Rewrite. | ||
| 123 | (dired-filename-at-point): Use when and or. | ||
| 124 | (dired-x-read-filename-at-point): Rename from read-filename-at-point. | ||
| 125 | Update callers. | ||
| 126 | |||
| 1 | 2011-02-15 Glenn Morris <rgm@gnu.org> | 127 | 2011-02-15 Glenn Morris <rgm@gnu.org> |
| 2 | 128 | ||
| 3 | * dired-x.el: Use easymenu for menu items. Fix item capitalization. | 129 | * dired-x.el: Use easymenu for menu items. Fix item capitalization. |
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el new file mode 100644 index 00000000000..75e1e5882f6 --- /dev/null +++ b/lisp/allout-widgets.el | |||
| @@ -0,0 +1,2365 @@ | |||
| 1 | ;; allout-widgets.el --- Show allout outline structure with graphical widgets. | ||
| 2 | |||
| 3 | ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer | ||
| 4 | |||
| 5 | ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> | ||
| 6 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> | ||
| 7 | ;; Version: 1.0 | ||
| 8 | ;; Created: Dec 2005 | ||
| 9 | ;; Version: 1.0 | ||
| 10 | ;; Keywords: outlines | ||
| 11 | ;; Website: http://myriadicity.net/Sundry/EmacsAllout | ||
| 12 | |||
| 13 | ;;; Commentary: | ||
| 14 | |||
| 15 | ;; This is an allout outline-mode add-on that highlights outline structure | ||
| 16 | ;; with graphical widgets. | ||
| 17 | ;; | ||
| 18 | ;; To activate, customize `allout-widgets-auto-activation'. You can also | ||
| 19 | ;; invoke allout-widgets-mode in a particular allout buffer. When | ||
| 20 | ;; auto-enabled, you can inhibit widget operation in particular allout | ||
| 21 | ;; buffers by setting the variable `allout-widgets-mode-inhibit' non-nil in | ||
| 22 | ;; that file's buffer. Use emacs *file local variables* to generally | ||
| 23 | ;; inhibit for a file. | ||
| 24 | ;; | ||
| 25 | ;; See the `allout-widgets-mode' docstring for more details. | ||
| 26 | ;; | ||
| 27 | ;; Info about allout and allout-widgets development are available at | ||
| 28 | ;; http://myriadicity.net/Sundry/EmacsAllout | ||
| 29 | ;; | ||
| 30 | ;; The graphics include: | ||
| 31 | ;; | ||
| 32 | ;; - icons for item bullets, varying to distinguish whether the item either | ||
| 33 | ;; lacks any subitems, the subitems are currently collapsed within the | ||
| 34 | ;; item, or the item is currently expanded. | ||
| 35 | ;; | ||
| 36 | ;; - guide lines connecting item bullet-icons with those of their subitems. | ||
| 37 | ;; | ||
| 38 | ;; - cue area between the bullet-icon and the start of the body headline, | ||
| 39 | ;; for item numbering, encryption indicator, and distinctive bullets. | ||
| 40 | ;; | ||
| 41 | ;; The bullet-icon and guide line graphics provide keybindings and mouse | ||
| 42 | ;; bindings for easy outline navigation and exposure control, extending | ||
| 43 | ;; outline hot-spot navigation (see `allout-mode' docstring for details). | ||
| 44 | ;; | ||
| 45 | ;; Developers note: Our use of emacs widgets is unconventional. We | ||
| 46 | ;; decorate existing text rather than substituting for it, to | ||
| 47 | ;; piggy-back on existing allout operation. This employs the C-coded | ||
| 48 | ;; efficiencies of widget-apply, widget-get, and widget-put, along | ||
| 49 | ;; with the basic object-oriented organization of widget-create, to | ||
| 50 | ;; systematically couple overlays, graphics, and other features with | ||
| 51 | ;; allout-governed text. | ||
| 52 | |||
| 53 | ;;;_: Code (structured with comments that delinieate an allout outline) | ||
| 54 | |||
| 55 | ;;;_ : General Environment | ||
| 56 | (require 'allout) | ||
| 57 | (require 'widget) | ||
| 58 | (require 'wid-edit) | ||
| 59 | |||
| 60 | (eval-when-compile | ||
| 61 | (progn | ||
| 62 | (require 'overlay) | ||
| 63 | (require 'cl) | ||
| 64 | )) | ||
| 65 | |||
| 66 | ;;;_ : internal variables needed before user-customization variables | ||
| 67 | ;;; In order to enable activation of allout-widgets-mode via customization, | ||
| 68 | ;;; allout-widgets-auto-activation uses a setting function. That function | ||
| 69 | ;;; is invoked when the customization variable definition is evaluated, | ||
| 70 | ;;; during file load, so the involved code must reside above that | ||
| 71 | ;;; definition in the file. | ||
| 72 | ;;;_ = allout-widgets-mode | ||
| 73 | (defvar allout-widgets-mode nil | ||
| 74 | "Allout mode enhanced with graphical widgets.") | ||
| 75 | (make-variable-buffer-local 'allout-widgets-mode) | ||
| 76 | |||
| 77 | ;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions: | ||
| 78 | ;;;_ > defgroup allout-widgets | ||
| 79 | ;;;###autoload | ||
| 80 | (defgroup allout-widgets nil | ||
| 81 | "Allout extension that highlights outline structure graphically. | ||
| 82 | |||
| 83 | Customize `allout-widgets-auto-activation' to activate allout-widgets | ||
| 84 | with allout-mode." | ||
| 85 | :group 'allout) | ||
| 86 | ;;;_ > defgroup allout-widgets-developer | ||
| 87 | (defgroup allout-widgets-developer nil | ||
| 88 | "Settings for development of allout widgets extension." | ||
| 89 | :group 'allout-widgets) | ||
| 90 | ;;;_ ; some functions a bit early, for allout-auto-activation dependency: | ||
| 91 | ;;;_ > allout-widgets-mode-enable | ||
| 92 | (defun allout-widgets-mode-enable () | ||
| 93 | "Enable allout-widgets-mode in allout-mode buffers. | ||
| 94 | |||
| 95 | See `allout-widgets-mode-inhibit' for per-file/per-buffer | ||
| 96 | inhibition of allout-widgets-mode." | ||
| 97 | (add-hook 'allout-mode-off-hook 'allout-widgets-mode-off) | ||
| 98 | (add-hook 'allout-mode-on-hook 'allout-widgets-mode-on) | ||
| 99 | t) | ||
| 100 | ;;;_ > allout-widgets-mode-disable | ||
| 101 | (defun allout-widgets-mode-disable () | ||
| 102 | "Disable allout-widgets-mode in allout-mode buffers. | ||
| 103 | |||
| 104 | See `allout-widgets-mode-inhibit' for per-file/per-buffer | ||
| 105 | inhibition of allout-widgets-mode." | ||
| 106 | (remove-hook 'allout-mode-off-hook 'allout-widgets-mode-off) | ||
| 107 | (remove-hook 'allout-mode-on-hook 'allout-widgets-mode-on) | ||
| 108 | t) | ||
| 109 | ;;;_ > allout-widgets-setup (varname value) | ||
| 110 | ;;;###autoload | ||
| 111 | (defun allout-widgets-setup (varname value) | ||
| 112 | "Commission or decommision allout-widgets-mode along with allout-mode. | ||
| 113 | |||
| 114 | Meant to be used by customization of `allout-widgets-auto-activation'." | ||
| 115 | (set-default varname value) | ||
| 116 | (if allout-widgets-auto-activation | ||
| 117 | (allout-widgets-mode-enable) | ||
| 118 | (allout-widgets-mode-disable))) | ||
| 119 | ;;;_ = allout-widgets-auto-activation | ||
| 120 | ;;;###autoload | ||
| 121 | (defcustom allout-widgets-auto-activation nil | ||
| 122 | "Activate to enable allout icon graphics wherever allout mode is active. | ||
| 123 | |||
| 124 | Also enable `allout-auto-activation' for this to take effect upon | ||
| 125 | visiting an outline. | ||
| 126 | |||
| 127 | When this is set you can disable allout widgets in select files | ||
| 128 | by setting `allout-widgets-mode-inhibit' | ||
| 129 | |||
| 130 | Instead of setting `allout-widgets-auto-activation' you can | ||
| 131 | explicitly invoke `allout-widgets-mode' in allout buffers where | ||
| 132 | you want allout widgets operation. | ||
| 133 | |||
| 134 | See `allout-widgets-mode' for allout widgets mode features." | ||
| 135 | :type 'boolean | ||
| 136 | :group 'allout-widgets | ||
| 137 | :set 'allout-widgets-setup | ||
| 138 | ) | ||
| 139 | ;; ;;;_ = allout-widgets-allow-unruly-edits | ||
| 140 | ;; (defcustom allout-widgets-allow-unruly-edits nil | ||
| 141 | ;; "*Control whether manual edits are restricted to maintain outline integrity. | ||
| 142 | |||
| 143 | ;; When nil, manual edits must either be within an item's body or encompass | ||
| 144 | ;; one or more items completely - eg, killing topics as entities, rather than | ||
| 145 | ;; deleting from the middle of one to the middle of another. | ||
| 146 | |||
| 147 | ;; If you only occasionally need to make unrestricted change, you can set this | ||
| 148 | ;; variable in the specific buffer using set-variable, or just deactivate | ||
| 149 | ;; `allout-mode' temporarily. You can customize this to always allow unruly | ||
| 150 | ;; edits, but you will be able to create outlines that are unnavigable in | ||
| 151 | ;; principle, and not just for allout's navigation and exposure mechanisms." | ||
| 152 | ;; :type 'boolean | ||
| 153 | ;; :group allout-widgets) | ||
| 154 | ;; (make-variable-buffer-local 'allout-widgets-allow-unruly-edits) | ||
| 155 | ;;;_ = allout-widgets-auto-activation - below, for eval-order dependencies | ||
| 156 | ;;;_ = allout-widgets-icons-dark-subdir | ||
| 157 | (defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets/dark-bg/" | ||
| 158 | "Directory on `image-load-path' holding allout icons for dark backgrounds." | ||
| 159 | :type 'string | ||
| 160 | :group 'allout-widgets) | ||
| 161 | ;;;_ = allout-widgets-icons-light-subdir | ||
| 162 | (defcustom allout-widgets-icons-light-subdir "icons/allout-widgets/light-bg/" | ||
| 163 | "Directory on `image-load-path' holding allout icons for light backgrounds." | ||
| 164 | :type 'string | ||
| 165 | :group 'allout-widgets) | ||
| 166 | ;;;_ = allout-widgets-icon-types | ||
| 167 | (defcustom allout-widgets-icon-types '(xpm png) | ||
| 168 | "File extensions for the icon graphic format types, in order of preference." | ||
| 169 | :type '(repeat symbol) | ||
| 170 | :group 'allout-widgets) | ||
| 171 | |||
| 172 | ;;;_ . Decoration format | ||
| 173 | ;;;_ = allout-widgets-theme-dark-background | ||
| 174 | (defcustom allout-widgets-theme-dark-background "allout-dark-bg" | ||
| 175 | "Identify the outline's icon theme to use with a dark background." | ||
| 176 | :type '(string) | ||
| 177 | :group 'allout-widgets) | ||
| 178 | ;;;_ = allout-widgets-theme-light-background | ||
| 179 | (defcustom allout-widgets-theme-light-background "allout-light-bg" | ||
| 180 | "Identify the outline's icon theme to use with a light background." | ||
| 181 | :type '(string) | ||
| 182 | :group 'allout-widgets) | ||
| 183 | ;;;_ = allout-widgets-item-image-properties-emacs | ||
| 184 | (defcustom allout-widgets-item-image-properties-emacs | ||
| 185 | '(:ascent center :mask (heuristic t)) | ||
| 186 | "*Default properties item widget images in mainline Emacs." | ||
| 187 | :type 'plist | ||
| 188 | :group 'allout-widgets) | ||
| 189 | ;;;_ = allout-widgets-item-image-properties-xemacs | ||
| 190 | (defcustom allout-widgets-item-image-properties-xemacs | ||
| 191 | nil | ||
| 192 | "*Default properties item widget images in XEmacs." | ||
| 193 | :type 'plist | ||
| 194 | :group 'allout-widgets) | ||
| 195 | ;;;_ . Developer | ||
| 196 | ;;;_ = allout-widgets-run-unit-tests-on-load | ||
| 197 | (defcustom allout-widgets-run-unit-tests-on-load nil | ||
| 198 | "*When non-nil, unit tests will be run at end of loading allout-widgets. | ||
| 199 | |||
| 200 | Generally, allout widgets code developers are the only ones who'll want to | ||
| 201 | set this. | ||
| 202 | |||
| 203 | \(If set, this makes it an even better practice to exercise changes by | ||
| 204 | doing byte-compilation with a repeat count, so the file is loaded after | ||
| 205 | compilation.) | ||
| 206 | |||
| 207 | See `allout-widgets-run-unit-tests' to see what's run." | ||
| 208 | :type 'boolean | ||
| 209 | :group 'allout-widgets-developer) | ||
| 210 | ;;;_ = allout-widgets-time-decoration-activity | ||
| 211 | (defcustom allout-widgets-time-decoration-activity nil | ||
| 212 | "*Retain timing info of the last cooperative redecoration. | ||
| 213 | |||
| 214 | The details are retained as the value of | ||
| 215 | `allout-widgets-last-decoration-timing'. | ||
| 216 | |||
| 217 | Generally, allout widgets code developers are the only ones who'll want to | ||
| 218 | set this." | ||
| 219 | :type 'boolean | ||
| 220 | :group 'allout-widgets-developer) | ||
| 221 | ;;;_ = allout-widgets-hook-error-post-time 0 | ||
| 222 | (defcustom allout-widgets-hook-error-post-time 0 | ||
| 223 | "*Amount of time to sit showing hook error messages. | ||
| 224 | |||
| 225 | 0 is minimal, or nil to not post to the message area. | ||
| 226 | |||
| 227 | This is for debugging purposes." | ||
| 228 | :type 'integer | ||
| 229 | :group 'allout-widgets-developer) | ||
| 230 | ;;;_ = allout-widgets-maintain-tally nil | ||
| 231 | (defcustom allout-widgets-maintain-tally nil | ||
| 232 | "*If non-nil, maintain a collection of widgets, `allout-widgets-tally'. | ||
| 233 | |||
| 234 | This is for debugging purposes. | ||
| 235 | |||
| 236 | The tally shows the total number of item widgets in the current | ||
| 237 | buffer, and tracking increases as new widgets are added and | ||
| 238 | decreases as obsolete widgets are garbage collected." | ||
| 239 | :type 'boolean | ||
| 240 | :group 'allout-widgets-developer) | ||
| 241 | (defvar allout-widgets-tally nil | ||
| 242 | "Hash-table of existing allout widgets, for debugging. | ||
| 243 | |||
| 244 | Table is maintained iff `allout-widgets-maintain-tally' is non-nil. | ||
| 245 | |||
| 246 | The table contents will be out of sync if any widgets are created | ||
| 247 | or deleted while this variable is nil.") | ||
| 248 | (make-variable-buffer-local 'allout-widgets-tally) | ||
| 249 | ;;;_ > allout-widgets-tally-string | ||
| 250 | (defun allout-widgets-tally-string () | ||
| 251 | "Return a string giving the number of tracked widgets, or empty string if not tracking. | ||
| 252 | |||
| 253 | The string is formed for appending to the allout-mode mode-line lighter. | ||
| 254 | |||
| 255 | An empty string is also returned if tracking is inhibited or | ||
| 256 | widgets are locally inhibited. | ||
| 257 | |||
| 258 | The number varies according to the evanescence of objects on a | ||
| 259 | hash table with weak keys, so tracking of widget erasures is often delayed." | ||
| 260 | (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit)) | ||
| 261 | (format ":%s" (hash-table-count allout-widgets-tally)))) | ||
| 262 | ;;;_ = allout-widgets-track-decoration nil | ||
| 263 | (defcustom allout-widgets-track-decoration nil | ||
| 264 | "*If non-nil, show cursor position of each item decoration. | ||
| 265 | |||
| 266 | This is for debugging purposes, and generally set at need in a | ||
| 267 | buffer rather than as a prevailing configuration \(but it's handy | ||
| 268 | to publicize it by making it a customization variable\)." | ||
| 269 | :type 'boolean | ||
| 270 | :group 'allout-widgets-developer) | ||
| 271 | (make-variable-buffer-local 'allout-widgets-track-decoration) | ||
| 272 | |||
| 273 | ;;;_ : Mode context - variables, hookup, and hooks | ||
| 274 | ;;;_ . internal mode variables | ||
| 275 | ;;;_ , Mode activation and environment | ||
| 276 | ;;;_ = allout-widgets-version | ||
| 277 | (defvar allout-widgets-version "1.0" | ||
| 278 | "Version of currently loaded allout-widgets extension.") | ||
| 279 | ;;;_ > allout-widgets-version | ||
| 280 | (defun allout-widgets-version (&optional here) | ||
| 281 | "Return string describing the loaded outline version." | ||
| 282 | (interactive "P") | ||
| 283 | (let ((msg (concat "Allout Outline Widgets Extension v " | ||
| 284 | allout-widgets-version))) | ||
| 285 | (if here (insert msg)) | ||
| 286 | (message "%s" msg) | ||
| 287 | msg)) | ||
| 288 | ;;;_ = allout-widgets-mode-inhibit | ||
| 289 | (defvar allout-widgets-mode-inhibit nil | ||
| 290 | "Inhibit `allout-widgets-mode' from activating widgets. | ||
| 291 | |||
| 292 | This also inhibits automatic adjustment of widgets to track allout outline | ||
| 293 | changes. | ||
| 294 | |||
| 295 | You can use this as a file local variable setting to disable | ||
| 296 | allout widgets enhancements in selected buffers while generally | ||
| 297 | enabling widgets by customizing `allout-widgets-auto-activation'. | ||
| 298 | |||
| 299 | In addition, you can invoked `allout-widgets-mode' allout-mode | ||
| 300 | buffers where this is set to enable and disable widget | ||
| 301 | enhancements, directly.") | ||
| 302 | ;;;###autoload | ||
| 303 | (put 'allout-widgets-mode-inhibit 'safe-local-variable | ||
| 304 | (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) | ||
| 305 | (make-variable-buffer-local 'allout-widgets-mode-inhibit) | ||
| 306 | ;;;_ = allout-inhibit-body-modification-hook | ||
| 307 | (defvar allout-inhibit-body-modification-hook nil | ||
| 308 | "Override de-escaping of text-prefixes in item bodies during specific changes. | ||
| 309 | |||
| 310 | This is used by `allout-buffer-modification-handler' to signal such changes | ||
| 311 | to `allout-body-modification-handler', and is always reset by | ||
| 312 | `allout-post-command-business'.") | ||
| 313 | (make-variable-buffer-local 'allout-inhibit-body-modification-hook) | ||
| 314 | ;;;_ = allout-widgets-icons-cache | ||
| 315 | (defvar allout-widgets-icons-cache nil | ||
| 316 | "Cache allout icon images, as an association list. | ||
| 317 | |||
| 318 | `allout-fetch-icon-image' uses this cache transparently, keying | ||
| 319 | images with lists containing the name of the icon directory \(as | ||
| 320 | found on the `load-path') and the icon name. | ||
| 321 | |||
| 322 | Set this variable to `nil' to empty the cache, and have it replenish from the | ||
| 323 | filesystem.") | ||
| 324 | ;;;_ = allout-widgets-unset-inhibit-read-only | ||
| 325 | (defvar allout-widgets-unset-inhibit-read-only nil | ||
| 326 | "Tell `allout-widgets-post-command-business' to unset `inhibit-read-only'. | ||
| 327 | |||
| 328 | Used by `allout-graphics-modification-handler'") | ||
| 329 | ;;;_ = allout-widgets-reenable-before-change-handler | ||
| 330 | (defvar allout-widgets-reenable-before-change-handler nil | ||
| 331 | "Tell `allout-widgets-post-command-business' to reequip the handler. | ||
| 332 | |||
| 333 | Necessary because the handler sometimes deliberately raises an | ||
| 334 | error, causing it to be disabled.") | ||
| 335 | ;;;_ , State for hooks | ||
| 336 | ;;;_ = allout-unresolved-body-mod-workroster | ||
| 337 | (defvar allout-unresolved-body-mod-workroster (make-hash-table :size 16) | ||
| 338 | "List of body-overlays that did before-change business but not after-change. | ||
| 339 | |||
| 340 | See `allout-post-command-business' and `allout-body-modification-handler'.") | ||
| 341 | ;;;_ = allout-structure-unruly-deletion-message | ||
| 342 | (defvar allout-structure-unruly-deletion-message | ||
| 343 | "Unruly edit prevented -- | ||
| 344 | To change the bullet character: \\[allout-rebullet-current-heading] | ||
| 345 | To promote this item: \\[allout-shift-out] | ||
| 346 | To demote it: \\[allout-shift-in] | ||
| 347 | To delete it and offspring: \\[allout-kill-topic] | ||
| 348 | See \\[describe-mode] for many more options." | ||
| 349 | "Informative message presented on improper editing of outline structure. | ||
| 350 | |||
| 351 | The structure includes the guides lines, bullet, and bullet cue.") | ||
| 352 | ;;;_ = allout-widgets-changes-record | ||
| 353 | (defvar allout-widgets-changes-record nil | ||
| 354 | "Record outline changes for processing by post-command hook. | ||
| 355 | |||
| 356 | Entries on the list are lists whose first element is a symbol indicating | ||
| 357 | the change type and subsequent elements are data specific to that change | ||
| 358 | type. Specifically: | ||
| 359 | |||
| 360 | 'exposure `allout-exposure-from' `allout-exposure-to' `allout-exposure-flag' | ||
| 361 | |||
| 362 | The changes are recorded in reverse order, with new values pushed | ||
| 363 | onto the front.") | ||
| 364 | (make-variable-buffer-local 'allout-widgets-changes-record) | ||
| 365 | ;;;_ = allout-widgets-undo-exposure-record | ||
| 366 | (defvar allout-widgets-undo-exposure-record nil | ||
| 367 | "Record outline undo traces for processing by post-command hook. | ||
| 368 | |||
| 369 | The changes are recorded in reverse order, with new values pushed | ||
| 370 | onto the front.") | ||
| 371 | (make-variable-buffer-local 'allout-widgets-undo-exposure-record) | ||
| 372 | ;;;_ = allout-widgets-last-hook-error | ||
| 373 | (defvar allout-widgets-last-hook-error nil | ||
| 374 | "String holding last error string, for debugging purposes.") | ||
| 375 | ;;;_ = allout-widgets-adjust-message-length-threshold 100 | ||
| 376 | (defvar allout-widgets-adjust-message-length-threshold 100 | ||
| 377 | "Display \"Adjusting widgets\" message above this number of pending changes." | ||
| 378 | ) | ||
| 379 | ;;;_ = allout-widgets-adjust-message-size-threshold 10000 | ||
| 380 | (defvar allout-widgets-adjust-message-size-threshold 10000 | ||
| 381 | "Display \"Adjusting widgets\" message above this size of pending changes." | ||
| 382 | ) | ||
| 383 | ;;;_ = allout-doing-exposure-undo-processor nil | ||
| 384 | (defvar allout-undo-exposure-in-progress nil | ||
| 385 | "Maintained true during `allout-widgets-exposure-undo-processor'") | ||
| 386 | ;;;_ , Widget-specific outline text format | ||
| 387 | ;;;_ = allout-escaped-prefix-regexp | ||
| 388 | (defvar allout-escaped-prefix-regexp "" | ||
| 389 | "*Regular expression for body text that would look like an item prefix if | ||
| 390 | not altered with an escape sequence.") | ||
| 391 | (make-variable-buffer-local 'allout-escaped-prefix-regexp) | ||
| 392 | ;;;_ , Widget element formatting | ||
| 393 | ;;;_ = allout-item-icon-keymap | ||
| 394 | (defvar allout-item-icon-keymap | ||
| 395 | (let ((km (make-sparse-keymap))) | ||
| 396 | (dolist (digit '("0" "1" "2" "3" | ||
| 397 | "4" "5" "6" "7" "8" "9")) | ||
| 398 | (define-key km digit 'digit-argument)) | ||
| 399 | (define-key km "-" 'negative-argument) | ||
| 400 | ;; (define-key km [(return)] 'allout-tree-expand-command) | ||
| 401 | ;; (define-key km [(meta return)] 'allout-toggle-torso-command) | ||
| 402 | ;; (define-key km [(down-mouse-1)] 'allout-item-button-click) | ||
| 403 | ;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command) | ||
| 404 | ;; Override underlying mouse-1 and mouse-2 bindings in icon territory: | ||
| 405 | (define-key km [(mouse-1)] (lambda () (interactive) nil)) | ||
| 406 | (define-key km [(mouse-2)] (lambda () (interactive) nil)) | ||
| 407 | |||
| 408 | ;; Catchall, handles actual keybindings, dynamically doing keymap lookups: | ||
| 409 | (define-key km [t] 'allout-item-icon-key-handler) | ||
| 410 | |||
| 411 | km) | ||
| 412 | "General tree-node key bindings.") | ||
| 413 | ;;;_ = allout-item-body-keymap | ||
| 414 | (defvar allout-item-body-keymap | ||
| 415 | (let ((km (make-sparse-keymap)) | ||
| 416 | (local-map (current-local-map))) | ||
| 417 | ;; (define-key km [(control return)] 'allout-tree-expand-command) | ||
| 418 | ;; (define-key km [(meta return)] 'allout-toggle-torso-command) | ||
| 419 | ;; XXX We need to reset this per buffer's mode; we do so in | ||
| 420 | ;; allout-widgets-mode. | ||
| 421 | (if local-map | ||
| 422 | (set-keymap-parent km local-map)) | ||
| 423 | |||
| 424 | km) | ||
| 425 | "General key bindings for the text content of outline items.") | ||
| 426 | (make-variable-buffer-local 'allout-item-body-keymap) | ||
| 427 | ;;;_ = allout-body-span-category | ||
| 428 | (defvar allout-body-span-category nil | ||
| 429 | "Symbol carrying allout body-text overlay properties.") | ||
| 430 | ;;;_ = allout-cue-span-keymap | ||
| 431 | (defvar allout-cue-span-keymap | ||
| 432 | (let ((km (make-sparse-keymap))) | ||
| 433 | (set-keymap-parent km allout-item-icon-keymap) | ||
| 434 | km) | ||
| 435 | "Keymap used in the item cue area - the space between the icon and headline.") | ||
| 436 | ;;;_ = allout-escapes-category | ||
| 437 | (defvar allout-escapes-category nil | ||
| 438 | "Symbol for category of text property used to hide escapes of prefix-like | ||
| 439 | text in allout item bodies.") | ||
| 440 | ;;;_ = allout-guides-category | ||
| 441 | (defvar allout-guides-category nil | ||
| 442 | "Symbol carrying allout icon-guides overlay properties.") | ||
| 443 | ;;;_ = allout-guides-span-category | ||
| 444 | (defvar allout-guides-span-category nil | ||
| 445 | "Symbol carrying allout icon and guide lines overlay properties.") | ||
| 446 | ;;;_ = allout-icon-span-category | ||
| 447 | (defvar allout-icon-span-category nil | ||
| 448 | "Symbol carrying allout icon and guide lines overlay properties.") | ||
| 449 | ;;;_ = allout-cue-span-category | ||
| 450 | (defvar allout-cue-span-category nil | ||
| 451 | "Symbol carrying common properties of the space following the outline icon. | ||
| 452 | |||
| 453 | \(That space is used to convey selected cues indicating body qualities, | ||
| 454 | including things like: | ||
| 455 | - encryption '~' | ||
| 456 | - numbering '#' | ||
| 457 | - indirect reference '@' | ||
| 458 | - distinctive bullets - see `allout-distinctive-bullets-string'.\)") | ||
| 459 | ;;;_ = allout-span-to-category | ||
| 460 | (defvar allout-span-to-category | ||
| 461 | '((:guides-span . allout-guides-span-category) | ||
| 462 | (:cue-span . allout-cue-span-category) | ||
| 463 | (:icon-span . allout-icon-span-category) | ||
| 464 | (:body-span . allout-body-span-category)) | ||
| 465 | "Association list mapping span identifier to category identifier.") | ||
| 466 | ;;;_ = allout-trailing-category | ||
| 467 | (defvar allout-trailing-category nil | ||
| 468 | "Symbol carrying common properties of an overlay's trailing newline.") | ||
| 469 | ;;;_ , Developer | ||
| 470 | (defvar allout-widgets-last-decoration-timing nil | ||
| 471 | "Timing details for the last cooperative decoration action. | ||
| 472 | |||
| 473 | This is maintained when `allout-widgets-time-decoration-activity' is set. | ||
| 474 | |||
| 475 | The value is a list containing two elements: | ||
| 476 | - the elapsed time as a number of seconds | ||
| 477 | - the list of changes processed, a la `allout-widgets-changes-record'. | ||
| 478 | |||
| 479 | When active, the value is revised each time automatic decoration activity | ||
| 480 | happens in the buffer.") | ||
| 481 | (make-variable-buffer-local 'allout-widgets-last-decoration-timing) | ||
| 482 | ;;;_ . mode hookup | ||
| 483 | ;;;_ > define-minor-mode allout-widgets-mode (arg) | ||
| 484 | ;;;###autoload | ||
| 485 | (define-minor-mode allout-widgets-mode | ||
| 486 | "Allout-mode extension, providing graphical decoration of outline structure. | ||
| 487 | |||
| 488 | This is meant to operate along with allout-mode, via `allout-mode-hook'. | ||
| 489 | |||
| 490 | If optional argument ARG is greater than 0, enable. | ||
| 491 | If optional argument ARG is less than 0, disable. | ||
| 492 | Anything else, toggle between active and inactive. | ||
| 493 | |||
| 494 | The graphics include: | ||
| 495 | |||
| 496 | - guide lines connecting item bullet-icons with those of their subitems. | ||
| 497 | |||
| 498 | - icons for item bullets, varying to indicate whether or not the item | ||
| 499 | has subitems, and if so, whether or not the item is expanded. | ||
| 500 | |||
| 501 | - cue area between the bullet-icon and the start of the body headline, | ||
| 502 | for item numbering, encryption indicator, and distinctive bullets. | ||
| 503 | |||
| 504 | The bullet-icon and guide line graphics provide keybindings and mouse | ||
| 505 | bindings for easy outline navigation and exposure control, extending | ||
| 506 | outline hot-spot navigation \(see `allout-mode')." | ||
| 507 | |||
| 508 | :lighter nil | ||
| 509 | :keymap nil | ||
| 510 | |||
| 511 | ;; define-minor-mode handles any provided argument according to emacs | ||
| 512 | ;; minor-mode conventions - '(elisp) Minor Mode Conventions' - and sets | ||
| 513 | ;; allout-widgets-mode accordingly *before* running the body code, so we | ||
| 514 | ;; cue on that. | ||
| 515 | (if allout-widgets-mode | ||
| 516 | ;; Activating: | ||
| 517 | (progn | ||
| 518 | (allout-add-resumptions | ||
| 519 | ;; XXX user may need say in line-truncation/hscrolling - an option | ||
| 520 | ;; that abstracts mode. | ||
| 521 | ;; truncate text lines to keep guide lines intact: | ||
| 522 | '(truncate-lines t) | ||
| 523 | ;; and enable autoscrolling to ease view of text | ||
| 524 | '(auto-hscroll-mode t) | ||
| 525 | '(line-move-ignore-fields t) | ||
| 526 | '(widget-push-button-prefix "") | ||
| 527 | '(widget-push-button-suffix "") | ||
| 528 | ;; allout-escaped-prefix-regexp depends on allout-regexp: | ||
| 529 | (list 'allout-escaped-prefix-regexp (concat "\\(\\\\\\)" | ||
| 530 | "\\(" allout-regexp "\\)"))) | ||
| 531 | (allout-add-resumptions | ||
| 532 | (list 'allout-widgets-tally allout-widgets-tally) | ||
| 533 | (list 'allout-widgets-escapes-sanitization-regexp-pair | ||
| 534 | (list (concat "\\(\n\\|\\`\\)" | ||
| 535 | allout-escaped-prefix-regexp | ||
| 536 | ) | ||
| 537 | ;; Include everything but the escape symbol. | ||
| 538 | "\\1\\3")) | ||
| 539 | ) | ||
| 540 | |||
| 541 | (add-hook 'after-change-functions 'allout-widgets-after-change-handler | ||
| 542 | nil t) | ||
| 543 | |||
| 544 | (allout-setup-text-properties) | ||
| 545 | (add-to-invisibility-spec '(allout-torso . t)) | ||
| 546 | (add-to-invisibility-spec 'allout-escapes) | ||
| 547 | |||
| 548 | (if (current-local-map) | ||
| 549 | (set-keymap-parent allout-item-body-keymap (current-local-map))) | ||
| 550 | |||
| 551 | (add-hook 'allout-exposure-change-hook | ||
| 552 | 'allout-widgets-exposure-change-recorder nil 'local) | ||
| 553 | (add-hook 'allout-structure-added-hook | ||
| 554 | 'allout-widgets-additions-recorder nil 'local) | ||
| 555 | (add-hook 'allout-structure-deleted-hook | ||
| 556 | 'allout-widgets-deletions-recorder nil 'local) | ||
| 557 | (add-hook 'allout-structure-shifted-hook | ||
| 558 | 'allout-widgets-shifts-recorder nil 'local) | ||
| 559 | (add-hook 'allout-after-copy-or-kill-hook | ||
| 560 | 'allout-widgets-after-copy-or-kill-function nil 'local) | ||
| 561 | |||
| 562 | (add-hook 'before-change-functions 'allout-widgets-before-change-handler | ||
| 563 | nil 'local) | ||
| 564 | (add-hook 'post-command-hook 'allout-widgets-post-command-business | ||
| 565 | nil 'local) | ||
| 566 | (add-hook 'pre-command-hook 'allout-widgets-pre-command-business | ||
| 567 | nil 'local) | ||
| 568 | |||
| 569 | ;; init the widgets tally for debugging: | ||
| 570 | (if (not allout-widgets-tally) | ||
| 571 | (setq allout-widgets-tally (make-hash-table | ||
| 572 | :test 'eq :weakness 'key))) | ||
| 573 | ;; add tally count display on minor-mode-alist just after | ||
| 574 | ;; allout-mode entry. | ||
| 575 | ;; (we use ternary condition form to keep condition simple for deletion.) | ||
| 576 | (let* ((mode-line-entry '(allout-widgets-mode-inhibit "" | ||
| 577 | (:eval (allout-widgets-tally-string)))) | ||
| 578 | (associated (assoc (car mode-line-entry) minor-mode-alist)) | ||
| 579 | ;; need location for it only if not already present: | ||
| 580 | (after (and (not associated) | ||
| 581 | (memq (assq 'allout-mode minor-mode-alist) minor-mode-alist)))) | ||
| 582 | (if after | ||
| 583 | (rplacd after (cons mode-line-entry (cdr after))))) | ||
| 584 | (allout-widgets-prepopulate-buffer) | ||
| 585 | t) | ||
| 586 | ;; Deactivating: | ||
| 587 | (let ((inhibit-read-only t) | ||
| 588 | (was-modified (buffer-modified-p))) | ||
| 589 | |||
| 590 | (allout-widgets-undecorate-region (point-min)(point-max)) | ||
| 591 | (remove-from-invisibility-spec '(allout-torso . t)) | ||
| 592 | (remove-from-invisibility-spec 'allout-escapes) | ||
| 593 | |||
| 594 | (remove-hook 'after-change-functions | ||
| 595 | 'allout-widgets-after-change-handler 'local) | ||
| 596 | (remove-hook 'allout-exposure-change-hook | ||
| 597 | 'allout-widgets-exposure-change-recorder 'local) | ||
| 598 | (remove-hook 'allout-structure-added-hook | ||
| 599 | 'allout-widgets-additions-recorder 'local) | ||
| 600 | (remove-hook 'allout-structure-deleted-hook | ||
| 601 | 'allout-widgets-deletions-recorder 'local) | ||
| 602 | (remove-hook 'allout-structure-shifted-hook | ||
| 603 | 'allout-widgets-shifts-recorder 'local) | ||
| 604 | (remove-hook 'allout-after-copy-or-kill-hook | ||
| 605 | 'allout-widgets-after-copy-or-kill-function 'local) | ||
| 606 | (remove-hook 'before-change-functions | ||
| 607 | 'allout-widgets-before-change-handler 'local) | ||
| 608 | (remove-hook 'post-command-hook | ||
| 609 | 'allout-widgets-post-command-business 'local) | ||
| 610 | (remove-hook 'pre-command-hook | ||
| 611 | 'allout-widgets-pre-command-business 'local) | ||
| 612 | (assq-delete-all 'allout-widgets-mode-inhibit minor-mode-alist) | ||
| 613 | (set-buffer-modified-p was-modified)))) | ||
| 614 | ;;;_ > allout-widgets-mode-off | ||
| 615 | (defun allout-widgets-mode-off () | ||
| 616 | "Explicitly disable allout-widgets-mode." | ||
| 617 | (allout-widgets-mode -1)) | ||
| 618 | ;;;_ > allout-widgets-mode-off | ||
| 619 | (defun allout-widgets-mode-on () | ||
| 620 | "Explicitly disable allout-widgets-mode." | ||
| 621 | (allout-widgets-mode 1)) | ||
| 622 | ;;;_ > allout-setup-text-properties () | ||
| 623 | (defun allout-setup-text-properties () | ||
| 624 | "Configure category and literal text properties." | ||
| 625 | |||
| 626 | ;; XXX body - before-change, entry, keymap | ||
| 627 | |||
| 628 | (setplist 'allout-guides-span-category nil) | ||
| 629 | (put 'allout-guides-span-category | ||
| 630 | 'modification-hooks '(allout-graphics-modification-handler)) | ||
| 631 | (put 'allout-guides-span-category 'local-map allout-item-icon-keymap) | ||
| 632 | (put 'allout-guides-span-category 'mouse-face widget-button-face) | ||
| 633 | (put 'allout-guides-span-category 'field 'structure) | ||
| 634 | ;; (put 'allout-guides-span-category 'face 'widget-button) | ||
| 635 | |||
| 636 | (setplist 'allout-icon-span-category | ||
| 637 | (allout-widgets-copy-list (symbol-plist | ||
| 638 | 'allout-guides-span-category))) | ||
| 639 | (put 'allout-icon-span-category 'field 'structure) | ||
| 640 | |||
| 641 | ;; XXX for body text we're instead going to use the buffer-wide | ||
| 642 | ;; resources, like before/after-change-functions hooks and the | ||
| 643 | ;; buffer's key map. that way we won't have to do painful provisions | ||
| 644 | ;; to fixup things after edits, catch outlier interstitial | ||
| 645 | ;; characters, like newline and empty lines after hidden subitems, | ||
| 646 | ;; etc. | ||
| 647 | (setplist 'allout-body-span-category nil) | ||
| 648 | (put 'allout-body-span-category 'evaporate t) | ||
| 649 | (put 'allout-body-span-category 'local-map allout-item-body-keymap) | ||
| 650 | ;;(put 'allout-body-span-category | ||
| 651 | ;; 'modification-hooks '(allout-body-modification-handler)) | ||
| 652 | ;;(put 'allout-body-span-category 'field 'body) | ||
| 653 | |||
| 654 | (setplist 'allout-cue-span-category nil) | ||
| 655 | (put 'allout-cue-span-category 'evaporate t) | ||
| 656 | (put 'allout-cue-span-category | ||
| 657 | 'modification-hooks '(allout-body-modification-handler)) | ||
| 658 | (put 'allout-cue-span-category 'local-map allout-cue-span-keymap) | ||
| 659 | (put 'allout-cue-span-category 'mouse-face widget-button-face) | ||
| 660 | (put 'allout-cue-span-category 'pointer 'arrow) | ||
| 661 | (put 'allout-cue-span-category 'field 'structure) | ||
| 662 | |||
| 663 | (setplist 'allout-trailing-category nil) | ||
| 664 | (put 'allout-trailing-category 'evaporate t) | ||
| 665 | (put 'allout-trailing-category 'local-map allout-item-body-keymap) | ||
| 666 | |||
| 667 | (setplist 'allout-escapes-category nil) | ||
| 668 | (put 'allout-escapes-category 'invisible 'allout-escapes) | ||
| 669 | (put 'allout-escapes-category 'evaporate t)) | ||
| 670 | ;;;_ > allout-widgets-prepopulate-buffer () | ||
| 671 | (defun allout-widgets-prepopulate-buffer () | ||
| 672 | "Step over the current buffers exposed items to do initial widgetizing." | ||
| 673 | (if (not allout-widgets-mode-inhibit) | ||
| 674 | (save-excursion | ||
| 675 | (goto-char (point-min)) | ||
| 676 | (while (allout-next-visible-heading 1) | ||
| 677 | (when (not (widget-at (point))) | ||
| 678 | (allout-get-or-create-item-widget)))))) | ||
| 679 | ;;;_ . settings context | ||
| 680 | ;;;_ = allout-container-item | ||
| 681 | (defvar allout-container-item-widget nil | ||
| 682 | "A widget for the current outline's overarching container as an item. | ||
| 683 | |||
| 684 | The item has settings \(of the file/connection\) and maybe a body, but no | ||
| 685 | icon/bullet.") | ||
| 686 | (make-variable-buffer-local 'allout-container-item-widget) | ||
| 687 | ;;;_ . Hooks and hook helpers | ||
| 688 | ;;;_ , major command-loop business: | ||
| 689 | ;;;_ > allout-widgets-pre-command-business (&optional recursing) | ||
| 690 | (defun allout-widgets-pre-command-business (&optional recursing) | ||
| 691 | "Handle actions pending before allout-mode activity." | ||
| 692 | ) | ||
| 693 | ;;;_ > allout-widgets-post-command-business (&optional recursing) | ||
| 694 | (defun allout-widgets-post-command-business (&optional recursing) | ||
| 695 | "Handle actions pending after any allout-mode commands. | ||
| 696 | |||
| 697 | Optional RECURSING is for internal use, to limit recursion." | ||
| 698 | ;; - check changed text for nesting discontinuities and escape anything | ||
| 699 | ;; that's: (1) asterisks at bol or (2) excessively nested. | ||
| 700 | (condition-case failure | ||
| 701 | |||
| 702 | (when (and (boundp 'allout-mode) allout-mode) | ||
| 703 | |||
| 704 | (if allout-widgets-unset-inhibit-read-only | ||
| 705 | (setq inhibit-read-only nil | ||
| 706 | allout-widgets-unset-inhibit-read-only nil)) | ||
| 707 | |||
| 708 | (when allout-widgets-reenable-before-change-handler | ||
| 709 | (add-hook 'before-change-functions | ||
| 710 | 'allout-widgets-before-change-handler | ||
| 711 | nil 'local) | ||
| 712 | (setq allout-widgets-reenable-before-change-handler nil)) | ||
| 713 | |||
| 714 | (when (or allout-widgets-undo-exposure-record | ||
| 715 | allout-widgets-changes-record) | ||
| 716 | (let* ((debug-on-signal t) | ||
| 717 | (debug-on-error t) | ||
| 718 | ;; inhibit recording new undo records when processing | ||
| 719 | ;; effects of undo-exposure: | ||
| 720 | (debugger 'allout-widgets-hook-error-handler) | ||
| 721 | (adjusting-message " Adjusting widgets...") | ||
| 722 | (replaced-message (allout-widgets-adjusting-message | ||
| 723 | adjusting-message)) | ||
| 724 | (start-time (current-time))) | ||
| 725 | |||
| 726 | (if allout-widgets-undo-exposure-record | ||
| 727 | ;; inhibit undo recording iff undoing exposure stuff. | ||
| 728 | ;; XXX we might need to inhibit per respective | ||
| 729 | ;; change-record, rather than assuming that some undo | ||
| 730 | ;; activity during a command is all undo activity. | ||
| 731 | (let ((buffer-undo-list t)) | ||
| 732 | (allout-widgets-exposure-undo-processor) | ||
| 733 | (allout-widgets-changes-dispatcher)) | ||
| 734 | (allout-widgets-exposure-undo-processor) | ||
| 735 | (allout-widgets-changes-dispatcher)) | ||
| 736 | |||
| 737 | (if allout-widgets-time-decoration-activity | ||
| 738 | (setq allout-widgets-last-decoration-timing | ||
| 739 | (list (allout-elapsed-time-seconds (current-time) | ||
| 740 | start-time) | ||
| 741 | allout-widgets-changes-record))) | ||
| 742 | |||
| 743 | (setq allout-widgets-changes-record nil) | ||
| 744 | |||
| 745 | (if replaced-message | ||
| 746 | (if (stringp replaced-message) | ||
| 747 | (message replaced-message) | ||
| 748 | (message ""))))) | ||
| 749 | |||
| 750 | ;; Detect undecorated items, eg during isearch into previously | ||
| 751 | ;; unexposed topics, and decorate "economically". Some | ||
| 752 | ;; undecorated stuff is often exposed, to reduce lag, but the | ||
| 753 | ;; item containing the cursor is decorated. We constrain | ||
| 754 | ;; recursion to avoid being trapped by unexpectedly undecoratable | ||
| 755 | ;; items. | ||
| 756 | (when (and (not recursing) | ||
| 757 | (not (allout-current-decorated-p)) | ||
| 758 | (or (not (equal (allout-depth) 0)) | ||
| 759 | (not allout-container-item-widget))) | ||
| 760 | (let ((buffer-undo-list t)) | ||
| 761 | (allout-widgets-exposure-change-recorder | ||
| 762 | allout-recent-prefix-beginning allout-recent-prefix-end nil) | ||
| 763 | (allout-widgets-post-command-business 'recursing))) | ||
| 764 | |||
| 765 | ;; Detect and rectify fouled outline structure - decorated item | ||
| 766 | ;; not at beginning of line. | ||
| 767 | (let ((this-widget (or (widget-at (point)) | ||
| 768 | ;; XXX we really should be checking across | ||
| 769 | ;; edited span, not just point and point+1 | ||
| 770 | (and (not (eq (point) (point-max))) | ||
| 771 | (widget-at (1+ (point)))))) | ||
| 772 | inserted-at) | ||
| 773 | (save-excursion | ||
| 774 | (if (and this-widget | ||
| 775 | (goto-char (widget-get this-widget :from)) | ||
| 776 | (not (bolp))) | ||
| 777 | (if (not | ||
| 778 | (condition-case err | ||
| 779 | (yes-or-no-p | ||
| 780 | (concat "Misplaced item won't be recognizable " | ||
| 781 | " as part of outline - rectify? ")) | ||
| 782 | (quit nil))) | ||
| 783 | (progn | ||
| 784 | (if (allout-hidden-p (max (1- (point)) 1)) | ||
| 785 | (save-excursion | ||
| 786 | (goto-char (max (1- (point)) 1)) | ||
| 787 | (allout-show-to-offshoot))) | ||
| 788 | (allout-widgets-undecorate-item this-widget)) | ||
| 789 | ;; expose any hidden intervening items, so resulting | ||
| 790 | ;; position is clear: | ||
| 791 | (setq inserted-at (point)) | ||
| 792 | (allout-unprotected (insert-before-markers "\n")) | ||
| 793 | (forward-char -1) | ||
| 794 | ;; ensure the inserted newline is visible: | ||
| 795 | (allout-flag-region inserted-at (1+ inserted-at) nil) | ||
| 796 | (allout-widgets-post-command-business 'recursing) | ||
| 797 | (message (concat "outline structure corrected - item" | ||
| 798 | " moved to beginning of new line")) | ||
| 799 | ;; preserve cursor position in some cases: | ||
| 800 | (if (and inserted-at | ||
| 801 | (> (point) inserted-at)) | ||
| 802 | (forward-char -1))))))) | ||
| 803 | |||
| 804 | (error | ||
| 805 | ;; zero work list so we don't get stuck futily retrying. | ||
| 806 | ;; error recording done by allout-widgets-hook-error-handler. | ||
| 807 | (setq allout-widgets-changes-record nil)))) | ||
| 808 | ;;;_ , major change handlers: | ||
| 809 | ;;;_ > allout-widgets-before-change-handler | ||
| 810 | (defun allout-widgets-before-change-handler (beg end) | ||
| 811 | "Business to be done before changes in a widgetized allout outline." | ||
| 812 | ;; protect against unruly edits to structure: | ||
| 813 | (cond | ||
| 814 | (undo-in-progress (when (eq (get-text-property beg 'category) | ||
| 815 | 'allout-icon-span-category) | ||
| 816 | (save-excursion | ||
| 817 | (goto-char beg) | ||
| 818 | (let* ((item-widget (allout-get-item-widget))) | ||
| 819 | (if item-widget | ||
| 820 | (allout-widgets-exposure-undo-recorder | ||
| 821 | item-widget)))))) | ||
| 822 | (inhibit-read-only t) | ||
| 823 | ((not (and (boundp 'allout-mode) allout-mode)) t) | ||
| 824 | ((equal this-command 'quoted-insert) t) | ||
| 825 | ((not (text-property-any beg (if (equal end beg) | ||
| 826 | (min (1+ beg) (point-max)) | ||
| 827 | end) | ||
| 828 | 'field 'structure)) | ||
| 829 | t) | ||
| 830 | ((yes-or-no-p "Unruly edit of outline structure - allow? ") | ||
| 831 | (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only) | ||
| 832 | inhibit-read-only t)) | ||
| 833 | (t | ||
| 834 | ;; tell the allout-widgets-post-command-business to reestablish the hook: | ||
| 835 | (setq allout-widgets-reenable-before-change-handler t) | ||
| 836 | ;; and raise an error to prevent the edit (and disable the hook): | ||
| 837 | (error | ||
| 838 | (substitute-command-keys allout-structure-unruly-deletion-message))))) | ||
| 839 | ;;;_ > allout-widgets-after-change-handler | ||
| 840 | (defun allout-widgets-after-change-handler (beg end prelength) | ||
| 841 | "Reconcile what needs to be reconciled for allout widgets after edits." | ||
| 842 | ) | ||
| 843 | ;;;_ > allout-current-decorated-p () | ||
| 844 | (defun allout-current-decorated-p () | ||
| 845 | "True if the current item is not decorated" | ||
| 846 | (save-excursion | ||
| 847 | (if (allout-back-to-current-heading) | ||
| 848 | (if (> allout-recent-depth 0) | ||
| 849 | (and (allout-get-item-widget) t) | ||
| 850 | allout-container-item-widget)))) | ||
| 851 | |||
| 852 | ;;;_ > allout-widgets-hook-error-handler | ||
| 853 | (defun allout-widgets-hook-error-handler (mode args) | ||
| 854 | "Process errors which occurred in the course of command hook operation. | ||
| 855 | |||
| 856 | We store a backtrace of the error information in the variable, | ||
| 857 | `allout-widgets-last-hook-error', unset the error handlers, and | ||
| 858 | reraise the error, so that processing continues to the | ||
| 859 | encompassing condition-case." | ||
| 860 | ;; first deconstruct special error environment so errors here propagate | ||
| 861 | ;; to encompassing condition-case: | ||
| 862 | (setq debugger 'debug | ||
| 863 | debug-on-error nil | ||
| 864 | debug-on-signal nil) | ||
| 865 | (let* ((bt (with-output-to-string (backtrace))) | ||
| 866 | (this "allout-widgets-hook-error-handler") | ||
| 867 | (header | ||
| 868 | (format "allout-widgets-last-hook-error stored, %s/%s %s %s" | ||
| 869 | this mode args | ||
| 870 | (format-time-string "%e-%b-%Y %r" (current-time))))) | ||
| 871 | ;; post to *Messages* then immediately replace with more compact notice: | ||
| 872 | (message "%s" (setq allout-widgets-last-hook-error | ||
| 873 | (format "%s:\n%s" header bt))) | ||
| 874 | (message header) (sit-for allout-widgets-hook-error-post-time) | ||
| 875 | ;; reraise the error, or one concerning this function if unexpected: | ||
| 876 | (if (equal mode 'error) | ||
| 877 | (apply 'signal args) | ||
| 878 | (error "%s: unexpected mode, %s %s" this mode args)))) | ||
| 879 | ;;;_ > allout-widgets-changes-exceed-threshold-p () | ||
| 880 | (defun allout-widgets-adjusting-message (message) | ||
| 881 | "Post MESSAGE when pending are likely to make a big enough delay. | ||
| 882 | |||
| 883 | If posting of the MESSAGE is warranted and there already is a | ||
| 884 | `current-message' in the minibuffer, the MESSAGE is appended to | ||
| 885 | the current one, and the previously pending `current-message' is | ||
| 886 | returned for later posting on completion. | ||
| 887 | |||
| 888 | If posting of the MESSAGE is warranted, but no `current-message' | ||
| 889 | is pending, then t is returned to indicate that case. | ||
| 890 | |||
| 891 | If posting of the MESSAGE is not warranted, then nil is returned. | ||
| 892 | |||
| 893 | See `allout-widgets-adjust-message-length-threshold', | ||
| 894 | `allout-widgets-adjust-message-size-threshold' for message | ||
| 895 | posting threshold criteria." | ||
| 896 | (if (or (> (length allout-widgets-changes-record) | ||
| 897 | allout-widgets-adjust-message-length-threshold) | ||
| 898 | ;; for size, use distance from start of first to end of last: | ||
| 899 | (let ((min (point-max)) | ||
| 900 | (max 0) | ||
| 901 | first second) | ||
| 902 | (mapc (function (lambda (entry) | ||
| 903 | (if (eq :undone-exposure (car entry)) | ||
| 904 | nil | ||
| 905 | (setq first (cadr entry) | ||
| 906 | second (caddr entry)) | ||
| 907 | (if (< (min first second) min) | ||
| 908 | (setq min (min first second))) | ||
| 909 | (if (> (max first second) max) | ||
| 910 | (setq max (max first second)))))) | ||
| 911 | allout-widgets-changes-record) | ||
| 912 | (> (- max min) allout-widgets-adjust-message-size-threshold))) | ||
| 913 | (let ((prior (current-message))) | ||
| 914 | (message (if prior (concat prior " - " message) message)) | ||
| 915 | (or prior t)))) | ||
| 916 | ;;;_ > allout-widgets-changes-dispatcher () | ||
| 917 | (defun allout-widgets-changes-dispatcher () | ||
| 918 | "Dispatch CHANGES-RECORD items to respective widgets change processors." | ||
| 919 | |||
| 920 | (if (not allout-widgets-mode-inhibit) | ||
| 921 | (let* ((changes-record allout-widgets-changes-record) | ||
| 922 | (changes-pending (and changes-record t)) | ||
| 923 | entry | ||
| 924 | exposures | ||
| 925 | additions | ||
| 926 | deletions | ||
| 927 | shifts) | ||
| 928 | |||
| 929 | (when changes-pending | ||
| 930 | (while changes-record | ||
| 931 | (setq entry (pop changes-record)) | ||
| 932 | (case (car entry) | ||
| 933 | (:exposed (push entry exposures)) | ||
| 934 | (:added (push entry additions)) | ||
| 935 | (:deleted (push entry deletions)) | ||
| 936 | (:shifted (push entry shifts)))) | ||
| 937 | |||
| 938 | (if exposures | ||
| 939 | (allout-widgets-exposure-change-processor exposures)) | ||
| 940 | (if additions | ||
| 941 | (allout-widgets-additions-processor additions)) | ||
| 942 | (if deletions | ||
| 943 | (allout-widgets-deletions-processor deletions)) | ||
| 944 | (if shifts | ||
| 945 | (allout-widgets-shifts-processor shifts)))) | ||
| 946 | (when (not (equal allout-widgets-mode-inhibit 'undecorated)) | ||
| 947 | (allout-widgets-undecorate-region (point-min)(point-max)) | ||
| 948 | (setq allout-widgets-mode-inhibit 'undecorated)))) | ||
| 949 | ;;;_ > allout-widgets-exposure-change-recorder (from to flag) | ||
| 950 | (defun allout-widgets-exposure-change-recorder (from to flag) | ||
| 951 | "Record allout exposure changes for tracking during post-command processing. | ||
| 952 | |||
| 953 | Records changes in `allout-widgets-changes-record'." | ||
| 954 | (push (list :exposed from to flag) allout-widgets-changes-record)) | ||
| 955 | ;;;_ > allout-widgets-exposure-change-processor (changes) | ||
| 956 | (defun allout-widgets-exposure-change-processor (changes) | ||
| 957 | "Widgetize and adjust item widgets tracking allout outline exposure changes. | ||
| 958 | |||
| 959 | Generally invoked via `allout-exposure-change-hook'." | ||
| 960 | |||
| 961 | (let ((changes (sort changes (function (lambda (this next) | ||
| 962 | (< (cadr this) (cadr next)))))) | ||
| 963 | ;; have to distinguish between concealing and exposing so that, eg, | ||
| 964 | ;; `allout-expose-topic's mix is handled properly. | ||
| 965 | handled-expose | ||
| 966 | handled-conceal | ||
| 967 | covered | ||
| 968 | deactivate-mark) | ||
| 969 | |||
| 970 | (dolist (change changes) | ||
| 971 | (let (handling | ||
| 972 | (from (cadr change)) | ||
| 973 | bucket got | ||
| 974 | (to (caddr change)) | ||
| 975 | (flag (cadddr change)) | ||
| 976 | parent) | ||
| 977 | |||
| 978 | ;; swap from and to: | ||
| 979 | (if (< to from) (setq bucket to | ||
| 980 | to from | ||
| 981 | from bucket)) | ||
| 982 | |||
| 983 | ;; have we already handled exposure changes in this region? | ||
| 984 | (setq handling (if flag 'handled-conceal 'handled-expose) | ||
| 985 | got (allout-range-overlaps from to (symbol-value handling)) | ||
| 986 | covered (car got)) | ||
| 987 | (set handling (cadr got)) | ||
| 988 | |||
| 989 | (when (not covered) | ||
| 990 | (save-excursion | ||
| 991 | (goto-char from) | ||
| 992 | (cond | ||
| 993 | |||
| 994 | ;; collapsing: | ||
| 995 | (flag | ||
| 996 | (allout-widgets-undecorate-region from to) | ||
| 997 | (allout-beginning-of-current-line) | ||
| 998 | (let ((widget (allout-get-item-widget))) | ||
| 999 | (if (not widget) | ||
| 1000 | (allout-get-or-create-item-widget) | ||
| 1001 | (widget-apply widget :redecorate)))) | ||
| 1002 | |||
| 1003 | ;; expanding: | ||
| 1004 | (t | ||
| 1005 | (while (< (point) to) | ||
| 1006 | (allout-beginning-of-current-line) | ||
| 1007 | (setq parent (allout-get-item-widget)) | ||
| 1008 | (if (not parent) | ||
| 1009 | (setq parent (allout-get-or-create-item-widget)) | ||
| 1010 | (widget-apply parent :redecorate)) | ||
| 1011 | (allout-next-visible-heading 1) | ||
| 1012 | (if (widget-get parent :has-subitems) | ||
| 1013 | (allout-redecorate-visible-subtree parent)) | ||
| 1014 | (if (> (point) to) | ||
| 1015 | ;; subtree may be well beyond to - incorporate in ranges: | ||
| 1016 | (setq handled-expose | ||
| 1017 | (allout-range-overlaps from (point) handled-expose) | ||
| 1018 | covered (car handled-expose) | ||
| 1019 | handled-expose (cadr handled-expose))) | ||
| 1020 | (allout-next-visible-heading 1)))))))))) | ||
| 1021 | |||
| 1022 | ;;;_ > allout-widgets-additions-recorder (from to) | ||
| 1023 | (defun allout-widgets-additions-recorder (from to) | ||
| 1024 | "Record allout item additions for tracking during post-command processing. | ||
| 1025 | |||
| 1026 | Intended for use on `allout-structure-added-hook'. | ||
| 1027 | |||
| 1028 | FROM point at the start of the first new item and TO is point at the start | ||
| 1029 | of the last one. | ||
| 1030 | |||
| 1031 | Records changes in `allout-widgets-changes-record'." | ||
| 1032 | (push (list :added from to) allout-widgets-changes-record)) | ||
| 1033 | ;;;_ > allout-widgets-additions-processor (changes) | ||
| 1034 | (defun allout-widgets-additions-processor (changes) | ||
| 1035 | "Widgetize and adjust items tracking allout outline structure additions. | ||
| 1036 | |||
| 1037 | Dispatched by `allout-widgets-post-command-business' in response to | ||
| 1038 | :added entries recorded by `allout-widgets-additions-recorder'." | ||
| 1039 | (save-excursion | ||
| 1040 | (let (handled | ||
| 1041 | covered) | ||
| 1042 | (dolist (change changes) | ||
| 1043 | (let ((from (cadr change)) | ||
| 1044 | bucket | ||
| 1045 | (to (caddr change))) | ||
| 1046 | (if (< to from) (setq bucket to to from from bucket)) | ||
| 1047 | ;; have we already handled exposure changes in this region? | ||
| 1048 | (setq handled (allout-range-overlaps from to handled) | ||
| 1049 | covered (car handled) | ||
| 1050 | handled (cadr handled)) | ||
| 1051 | (when (not covered) | ||
| 1052 | (goto-char from) | ||
| 1053 | ;; Prior sibling and parent can both be affected. | ||
| 1054 | (if (allout-ascend) | ||
| 1055 | (allout-redecorate-visible-subtree | ||
| 1056 | (allout-get-or-create-item-widget 'redecorate))) | ||
| 1057 | (if (< (point) from) | ||
| 1058 | (goto-char from)) | ||
| 1059 | (while (and (< (point) to) (not (eobp))) | ||
| 1060 | (allout-beginning-of-current-line) | ||
| 1061 | (allout-redecorate-visible-subtree | ||
| 1062 | (allout-get-or-create-item-widget)) | ||
| 1063 | (allout-next-visible-heading 1)) | ||
| 1064 | (if (> (point) to) | ||
| 1065 | ;; subtree may be well beyond to - incorporate in ranges: | ||
| 1066 | (setq handled (allout-range-overlaps from (point) handled) | ||
| 1067 | covered (car handled) | ||
| 1068 | handled (cadr handled))))))))) | ||
| 1069 | |||
| 1070 | ;;;_ > allout-widgets-deletions-recorder (depth from) | ||
| 1071 | (defun allout-widgets-deletions-recorder (depth from) | ||
| 1072 | "Record allout item deletions for tracking during post-command processing. | ||
| 1073 | |||
| 1074 | Intended for use on `allout-structure-deleted-hook'. | ||
| 1075 | |||
| 1076 | DEPTH is the depth of the deleted subtree, and FROM is the point from which | ||
| 1077 | the subtree was deleted. | ||
| 1078 | |||
| 1079 | Records changes in `allout-widgets-changes-record'." | ||
| 1080 | (push (list :deleted depth from) allout-widgets-changes-record)) | ||
| 1081 | ;;;_ > allout-widgets-deletions-processor (changes) | ||
| 1082 | (defun allout-widgets-deletions-processor (changes) | ||
| 1083 | "Adjust items tracking allout outline structure deletions. | ||
| 1084 | |||
| 1085 | Dispatched by `allout-widgets-post-command-business' in response to | ||
| 1086 | :deleted entries recorded by `allout-widgets-deletions-recorder'." | ||
| 1087 | (save-excursion | ||
| 1088 | (dolist (change changes) | ||
| 1089 | (let ((depth (cadr change)) | ||
| 1090 | (from (caddr change))) | ||
| 1091 | (goto-char from) | ||
| 1092 | (when (allout-previous-visible-heading 1) | ||
| 1093 | (if (> depth 1) | ||
| 1094 | (allout-ascend-to-depth (1- depth))) | ||
| 1095 | (allout-redecorate-visible-subtree | ||
| 1096 | (allout-get-or-create-item-widget 'redecorate))))))) | ||
| 1097 | |||
| 1098 | ;;;_ > allout-widgets-shifts-recorder (shifted-amount at) | ||
| 1099 | (defun allout-widgets-shifts-recorder (shifted-amount at) | ||
| 1100 | "Record outline subtree shifts for tracking during post-command processing. | ||
| 1101 | |||
| 1102 | Intended for use on `allout-structure-shifted-hook'. | ||
| 1103 | |||
| 1104 | SHIFTED-AMOUNT is the depth change and AT is the point at the start of the | ||
| 1105 | subtree that's been shifted. | ||
| 1106 | |||
| 1107 | Records changes in `allout-widgets-changes-record'." | ||
| 1108 | (push (list :shifted shifted-amount at) allout-widgets-changes-record)) | ||
| 1109 | ;;;_ > allout-widgets-shifts-processor (changes) | ||
| 1110 | (defun allout-widgets-shifts-processor (changes) | ||
| 1111 | "Widgetize and adjust items tracking allout outline structure additions. | ||
| 1112 | |||
| 1113 | Dispatched by `allout-widgets-post-command-business' in response to | ||
| 1114 | :shifted entries recorded by `allout-widgets-shifts-recorder'." | ||
| 1115 | (save-excursion | ||
| 1116 | (dolist (change changes) | ||
| 1117 | (goto-char (caddr change)) | ||
| 1118 | (allout-ascend) | ||
| 1119 | (allout-redecorate-visible-subtree)))) | ||
| 1120 | ;;;_ > allout-widgets-after-copy-or-kill-function () | ||
| 1121 | (defun allout-widgets-after-copy-or-kill-function () | ||
| 1122 | "Do allout-widgets processing of text just placed in the kill ring. | ||
| 1123 | |||
| 1124 | Intended for use on allout-after-copy-or-kill-hook." | ||
| 1125 | (if (car kill-ring) | ||
| 1126 | (setcar kill-ring (allout-widgets-undecorate-text (car kill-ring))))) | ||
| 1127 | |||
| 1128 | ;;;_ > allout-widgets-exposure-undo-recorder (widget from-state) | ||
| 1129 | (defun allout-widgets-exposure-undo-recorder (widget) | ||
| 1130 | "Record outline exposure undo for tracking during post-command processing. | ||
| 1131 | |||
| 1132 | Intended for use by `allout-graphics-modification-handler'. | ||
| 1133 | |||
| 1134 | WIDGET is the widget being changed. | ||
| 1135 | |||
| 1136 | Records changes in `allout-widgets-changes-record'." | ||
| 1137 | ;; disregard the events if we're currently processing them. | ||
| 1138 | (if (not allout-undo-exposure-in-progress) | ||
| 1139 | (push widget allout-widgets-undo-exposure-record))) | ||
| 1140 | ;;;_ > allout-widgets-exposure-undo-processor () | ||
| 1141 | (defun allout-widgets-exposure-undo-processor () | ||
| 1142 | "Adjust items tracking undo of allout outline structure exposure. | ||
| 1143 | |||
| 1144 | Dispatched by `allout-widgets-post-command-business' in response to | ||
| 1145 | :undone-exposure entries recorded by `allout-widgets-exposure-undo-recorder'." | ||
| 1146 | (let* ((allout-undo-exposure-in-progress t) | ||
| 1147 | ;; inhibit undo recording while twiddling exposure to track undo: | ||
| 1148 | (widgets allout-widgets-undo-exposure-record) | ||
| 1149 | widget widget-start-marker widget-end-marker | ||
| 1150 | from-state icon-start-point to-state | ||
| 1151 | handled covered) | ||
| 1152 | (setq allout-widgets-undo-exposure-record nil) | ||
| 1153 | (save-excursion | ||
| 1154 | (dolist (widget widgets) | ||
| 1155 | (setq widget-start-marker (widget-get widget :from) | ||
| 1156 | widget-end-marker (widget-get widget :to) | ||
| 1157 | from-state (widget-get widget :icon-state) | ||
| 1158 | icon-start-point (widget-apply widget :actual-position | ||
| 1159 | :icon-start) | ||
| 1160 | to-state (get-text-property icon-start-point | ||
| 1161 | :icon-state)) | ||
| 1162 | (setq handled (allout-range-overlaps widget-start-marker | ||
| 1163 | widget-end-marker | ||
| 1164 | handled) | ||
| 1165 | covered (car handled) | ||
| 1166 | handled (cadr handled)) | ||
| 1167 | (when (not covered) | ||
| 1168 | (goto-char (widget-get widget :from)) | ||
| 1169 | (when (not (allout-hidden-p)) | ||
| 1170 | ;; adjust actual exposure to that of to-state viz from-state | ||
| 1171 | (cond ((and (eq to-state 'closed) (eq from-state 'opened)) | ||
| 1172 | (allout-hide-current-subtree) | ||
| 1173 | (allout-decorate-item-and-context widget)) | ||
| 1174 | ((and (eq to-state 'opened) (eq from-state 'closed)) | ||
| 1175 | (save-excursion | ||
| 1176 | (dolist | ||
| 1177 | (expose-to (allout-chart-exposure-contour-by-icon)) | ||
| 1178 | (goto-char expose-to) | ||
| 1179 | (allout-show-to-offshoot))))))))))) | ||
| 1180 | ;;;_ > allout-chart-exposure-contour-by-icon (&optional from-depth) | ||
| 1181 | (defun allout-chart-exposure-contour-by-icon (&optional from-depth) | ||
| 1182 | "Return points of subtree items to which exposure should be extended. | ||
| 1183 | |||
| 1184 | The qualifying items are ones with a widget icon that is in the closed or | ||
| 1185 | empty state, or items with undecorated subitems. | ||
| 1186 | |||
| 1187 | The resulting list of points is in reverse order. | ||
| 1188 | |||
| 1189 | Optional FROM-DEPTH is for internal use." | ||
| 1190 | ;; During internal recursion, we return a pair: (at-end . result) | ||
| 1191 | ;; Otherwise we just return the result. | ||
| 1192 | (let ((from-depth from-depth) | ||
| 1193 | start-point | ||
| 1194 | at-end level-depth | ||
| 1195 | this-widget | ||
| 1196 | got subgot) | ||
| 1197 | (if from-depth | ||
| 1198 | (setq level-depth (allout-depth)) | ||
| 1199 | ;; at containing item: | ||
| 1200 | (setq start-point (point)) | ||
| 1201 | (setq from-depth (allout-depth)) | ||
| 1202 | (setq at-end (not (allout-next-heading)) | ||
| 1203 | level-depth allout-recent-depth)) | ||
| 1204 | |||
| 1205 | ;; traverse the level, recursing on deeper levels: | ||
| 1206 | (while (and (not at-end) | ||
| 1207 | (> allout-recent-depth from-depth) | ||
| 1208 | (setq this-widget (allout-get-item-widget))) | ||
| 1209 | (if (< level-depth allout-recent-depth) | ||
| 1210 | ;; recurse: | ||
| 1211 | (progn | ||
| 1212 | (setq subgot (allout-chart-exposure-contour-by-icon level-depth) | ||
| 1213 | at-end (car subgot) | ||
| 1214 | subgot (cdr subgot)) | ||
| 1215 | (if subgot (setq got (append subgot got)))) | ||
| 1216 | ;; progress at this level: | ||
| 1217 | (when (memq (widget-get this-widget :icon-state) '(closed empty)) | ||
| 1218 | (push (point) got) | ||
| 1219 | (allout-end-of-subtree)) | ||
| 1220 | (setq at-end (not (allout-next-heading))))) | ||
| 1221 | |||
| 1222 | ;; tailor result depending on whether or not we're a recursion: | ||
| 1223 | (if (not start-point) | ||
| 1224 | (cons at-end got) | ||
| 1225 | (goto-char start-point) | ||
| 1226 | got))) | ||
| 1227 | ;;;_ > allout-range-overlaps (from to ranges) | ||
| 1228 | (defun allout-range-overlaps (from to ranges) | ||
| 1229 | "Return a pair indicating overlap of FROM and TO subtree range in RANGES. | ||
| 1230 | |||
| 1231 | First element of result indicates whether candadate range FROM, TO | ||
| 1232 | overlapped any of the existing ranges. | ||
| 1233 | |||
| 1234 | Second element of result is a new version of RANGES incorporating the | ||
| 1235 | candidate range with overlaps consolidated. | ||
| 1236 | |||
| 1237 | FROM and TO must be in increasing order, as must be the pairs in RANGES." | ||
| 1238 | ;; to append to the end: (rplacd next-to-last-cdr (list 'f)) | ||
| 1239 | (let (new-ranges | ||
| 1240 | entry | ||
| 1241 | ;; the start of the range that includes the candidate from: | ||
| 1242 | included-from | ||
| 1243 | ;; the end of the range that includes the candidate to: | ||
| 1244 | included-to | ||
| 1245 | ;; the candidates were inserted: | ||
| 1246 | done) | ||
| 1247 | (while (and ranges (not done)) | ||
| 1248 | (setq entry (car ranges) | ||
| 1249 | ranges (cdr ranges)) | ||
| 1250 | |||
| 1251 | (cond | ||
| 1252 | |||
| 1253 | (included-from | ||
| 1254 | ;; some entry included the candidate from. | ||
| 1255 | (cond ((> (car entry) to) | ||
| 1256 | ;; current entry exceeds end of candidate range - done. | ||
| 1257 | (push (list included-from to) new-ranges) | ||
| 1258 | (push entry new-ranges) | ||
| 1259 | (setq included-to to | ||
| 1260 | done t)) | ||
| 1261 | ((>= (cadr entry) to) | ||
| 1262 | ;; current entry includes end of candidate range - done. | ||
| 1263 | (push (list included-from (cadr entry)) new-ranges) | ||
| 1264 | (setq included-to (cadr entry) | ||
| 1265 | done t)) | ||
| 1266 | ;; current entry contained in candidate range - ditch, continue: | ||
| 1267 | (t nil))) | ||
| 1268 | |||
| 1269 | ((> (car entry) to) | ||
| 1270 | ;; current entry start exceeds candidate end - done, placed as new entry | ||
| 1271 | (push (list from to) new-ranges) | ||
| 1272 | (push entry new-ranges) | ||
| 1273 | (setq included-to to | ||
| 1274 | done t)) | ||
| 1275 | |||
| 1276 | ((>= (car entry) from) | ||
| 1277 | ;; current entry start is above candidate start, but not above | ||
| 1278 | ;; candidate end (by prior case). | ||
| 1279 | (setq included-from from) | ||
| 1280 | ;; now we have to check on whether this entry contains to, or continue: | ||
| 1281 | (when (>= (cadr entry) to) | ||
| 1282 | ;; current entry contains only candidate end - done: | ||
| 1283 | (push (list included-from (cadr entry)) new-ranges) | ||
| 1284 | (setq included-to (cadr entry) | ||
| 1285 | done t)) | ||
| 1286 | ;; otherwise, we will continue to look for placement of candidate end. | ||
| 1287 | ) | ||
| 1288 | |||
| 1289 | ((>= (cadr entry) to) | ||
| 1290 | ;; current entry properly contains candidate range. | ||
| 1291 | (push entry new-ranges) | ||
| 1292 | (setq included-from (car entry) | ||
| 1293 | included-to (cadr entry) | ||
| 1294 | done t)) | ||
| 1295 | |||
| 1296 | ((>= (cadr entry) from) | ||
| 1297 | ;; current entry contains start of candidate range. | ||
| 1298 | (setq included-from (car entry))) | ||
| 1299 | |||
| 1300 | (t | ||
| 1301 | ;; current entry is below the candidate range. | ||
| 1302 | (push entry new-ranges)))) | ||
| 1303 | |||
| 1304 | (cond ((and included-from included-to) | ||
| 1305 | ;; candidates placed. | ||
| 1306 | nil) | ||
| 1307 | ((not (or included-from included-to)) | ||
| 1308 | ;; candidates found no place, must be at the end: | ||
| 1309 | (push (list from to) new-ranges)) | ||
| 1310 | (included-from | ||
| 1311 | ;; candidate start placed but end not: | ||
| 1312 | (push (list included-from to) new-ranges)) | ||
| 1313 | ;; might be included-to and not included-from, indicating new entry. | ||
| 1314 | ) | ||
| 1315 | (setq new-ranges (nreverse new-ranges)) | ||
| 1316 | (if ranges (setq new-ranges (append new-ranges ranges))) | ||
| 1317 | (list (if included-from t) new-ranges))) | ||
| 1318 | ;;;_ > allout-test-range-overlaps () | ||
| 1319 | (defun allout-test-range-overlaps () | ||
| 1320 | "allout-range-overlaps unit tests." | ||
| 1321 | (let* (ranges | ||
| 1322 | got | ||
| 1323 | (try (lambda (from to) | ||
| 1324 | (setq got (allout-range-overlaps from to ranges)) | ||
| 1325 | (setq ranges (cadr got)) | ||
| 1326 | got))) | ||
| 1327 | ;; ;; biggie: | ||
| 1328 | ;; (setq ranges nil) | ||
| 1329 | ;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall | ||
| 1330 | ;; ;; ~ 13 seconds for doing repeated funcall | ||
| 1331 | ;; (message "time-trial: %s, resulting size %s" | ||
| 1332 | ;; (time-trial | ||
| 1333 | ;; '(let ((size 10000) | ||
| 1334 | ;; doing) | ||
| 1335 | ;; (random t) | ||
| 1336 | ;; (dotimes (count size) | ||
| 1337 | ;; (setq doing (random size)) | ||
| 1338 | ;; (funcall try doing (+ doing (random 5))) | ||
| 1339 | ;; ;;(list doing (+ doing (random 5))) | ||
| 1340 | ;; ))) | ||
| 1341 | ;; (length ranges)) | ||
| 1342 | ;; (sit-for 2) | ||
| 1343 | |||
| 1344 | ;; fresh: | ||
| 1345 | (setq ranges nil) | ||
| 1346 | (assert (equal (funcall try 3 5) '(nil ((3 5))))) | ||
| 1347 | ;; add range at end: | ||
| 1348 | (assert (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) | ||
| 1349 | ;; add range at beginning: | ||
| 1350 | (assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) | ||
| 1351 | ;; insert range somewhere in the middle: | ||
| 1352 | (assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) | ||
| 1353 | ;; consolidate some: | ||
| 1354 | (assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) | ||
| 1355 | ;; add more: | ||
| 1356 | (assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) | ||
| 1357 | ;; add more: | ||
| 1358 | (assert (equal (funcall try 20 22) | ||
| 1359 | '(nil ((1 2) (3 9) (10 12) (15 17) (20 22))))) | ||
| 1360 | ;; encompass more: | ||
| 1361 | (assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) | ||
| 1362 | ;; encompass all: | ||
| 1363 | (assert (equal (funcall try 2 25) '(t ((1 25))))) | ||
| 1364 | |||
| 1365 | ;; fresh slate: | ||
| 1366 | (setq ranges nil) | ||
| 1367 | (assert (equal (funcall try 20 25) '(nil ((20 25))))) | ||
| 1368 | (assert (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) | ||
| 1369 | (assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) | ||
| 1370 | (assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) | ||
| 1371 | (assert (equal (funcall try 10 30) '(t ((10 35))))) | ||
| 1372 | (assert (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) | ||
| 1373 | (assert (equal (funcall try 2 100) '(t ((2 100))))) | ||
| 1374 | |||
| 1375 | (setq ranges nil) | ||
| 1376 | )) | ||
| 1377 | ;;;_ > allout-widgetize-buffer (&optional doing) | ||
| 1378 | (defun allout-widgetize-buffer (&optional doing) | ||
| 1379 | "EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree. | ||
| 1380 | |||
| 1381 | We economize by just focusing on the first of local-maximum depth siblings. | ||
| 1382 | |||
| 1383 | Optional DOING is for internal use - a chart of the current level, for | ||
| 1384 | recursive operation." | ||
| 1385 | |||
| 1386 | (interactive) | ||
| 1387 | (if (not doing) | ||
| 1388 | |||
| 1389 | (save-excursion | ||
| 1390 | (goto-char (point-min)) | ||
| 1391 | ;; Construct the chart by scanning the siblings: | ||
| 1392 | (dolist (top-level-sibling (allout-chart-siblings)) | ||
| 1393 | (goto-char top-level-sibling) | ||
| 1394 | (let ((subchart (allout-chart-subtree))) | ||
| 1395 | (if subchart | ||
| 1396 | (allout-widgetize-buffer subchart))))) | ||
| 1397 | |||
| 1398 | ;; save-excursion was done on recursion entry, not necessary here. | ||
| 1399 | (let (have-sublists) | ||
| 1400 | (dolist (sibling doing) | ||
| 1401 | (when (listp sibling) | ||
| 1402 | (setq have-sublists t) | ||
| 1403 | (allout-widgetize-buffer sibling))) | ||
| 1404 | (when (and (not have-sublists) (not (widget-at (car doing)))) | ||
| 1405 | (goto-char (car doing)) | ||
| 1406 | (allout-get-or-create-item-widget))))) | ||
| 1407 | |||
| 1408 | ;;;_ : Item widget and constructors | ||
| 1409 | |||
| 1410 | ;;;_ $ allout-item-widget | ||
| 1411 | (define-widget 'allout-item-widget 'default | ||
| 1412 | "A widget presenting an allout outline item." | ||
| 1413 | |||
| 1414 | 'button nil | ||
| 1415 | ;; widget-field-at respects this to get item if 'field is unused. | ||
| 1416 | ;; we don't use field to avoid collision with end-of-line, etc, on which | ||
| 1417 | ;; allout depends. | ||
| 1418 | 'real-field nil | ||
| 1419 | |||
| 1420 | ;; data fields: | ||
| 1421 | |||
| 1422 | |||
| 1423 | ;; tailor the widget for a specific item | ||
| 1424 | :create 'allout-decorate-item-and-context | ||
| 1425 | :value-delete 'allout-widgets-undecorate-item | ||
| 1426 | ;; Not Yet Converted (from original, tree-widget stab) | ||
| 1427 | :expander 'allout-tree-event-dispatcher ; get children when nil :args | ||
| 1428 | :expander-p 'identity ; always engage the :expander | ||
| 1429 | :action 'allout-tree-widget-action | ||
| 1430 | ;; :notify "when item changes" | ||
| 1431 | |||
| 1432 | ;; force decoration of item but not context, unless already done this tick: | ||
| 1433 | :redecorate 'allout-redecorate-item | ||
| 1434 | :last-decorated-tick nil | ||
| 1435 | ;; recognize the actual situation of the item's text: | ||
| 1436 | :parse-item 'allout-parse-item-at-point | ||
| 1437 | ;; decorate the entirety of the item, sans offspring: | ||
| 1438 | :decorate-item-span 'allout-decorate-item-span | ||
| 1439 | ;; decorate the various item elements: | ||
| 1440 | :decorate-guides 'allout-decorate-item-guides | ||
| 1441 | :decorate-icon 'allout-decorate-item-icon | ||
| 1442 | :decorate-cue 'allout-decorate-item-cue | ||
| 1443 | :decorate-body 'allout-decorate-item-body | ||
| 1444 | :actual-position 'allout-item-actual-position | ||
| 1445 | |||
| 1446 | ;; Layout parameters: | ||
| 1447 | :is-container nil ; is this actually the encompassing file/connection? | ||
| 1448 | |||
| 1449 | :from nil ; item beginning - marker | ||
| 1450 | :to nil ; item end - marker | ||
| 1451 | :span-overlay nil ; overlay by which actual postion is determined | ||
| 1452 | |||
| 1453 | ;; also serves as guide-end: | ||
| 1454 | :icon-start nil | ||
| 1455 | :icon-end nil | ||
| 1456 | :distinctive-start nil | ||
| 1457 | ;; also serves as cue-start: | ||
| 1458 | :distinctive-end nil | ||
| 1459 | ;; also serves as cue-end: | ||
| 1460 | :body-start nil | ||
| 1461 | :body-end nil | ||
| 1462 | :depth nil | ||
| 1463 | :has-subitems nil | ||
| 1464 | :was-has-subitems 'init | ||
| 1465 | :expanded nil | ||
| 1466 | :was-expanded 'init | ||
| 1467 | :brief nil | ||
| 1468 | :was-brief 'init | ||
| 1469 | |||
| 1470 | :does-encrypt nil ; pending encryption when :is-encrypted false. | ||
| 1471 | :is-encrypted nil | ||
| 1472 | |||
| 1473 | ;; the actual location of the item text: | ||
| 1474 | :location 'allout-item-location | ||
| 1475 | |||
| 1476 | :button-keymap allout-item-icon-keymap ; XEmacs | ||
| 1477 | :keymap allout-item-icon-keymap ; Emacs | ||
| 1478 | |||
| 1479 | ;; Element regions: | ||
| 1480 | :guides-span nil | ||
| 1481 | :icon-span nil | ||
| 1482 | :cue-span nil | ||
| 1483 | :bullet nil | ||
| 1484 | :was-bullet nil | ||
| 1485 | :body-span nil | ||
| 1486 | |||
| 1487 | :body-brevity-p 'allout-body-brevity-p | ||
| 1488 | |||
| 1489 | ;; :guide-column-flags indicate (in reverse order) whether or not the | ||
| 1490 | ;; item's ancestor at the depth corresponding to the column has a | ||
| 1491 | ;; subsequent sibling - ie, whether or not the corresponding column needs | ||
| 1492 | ;; a descender line to connect that ancestor with its sibling. | ||
| 1493 | :guide-column-flags nil | ||
| 1494 | :was-guide-column-flags 'init | ||
| 1495 | |||
| 1496 | ;; ie, has subitems: | ||
| 1497 | :populous-p 'allout-item-populous-p | ||
| 1498 | :help-echo 'allout-tree-widget-help-echo | ||
| 1499 | ) | ||
| 1500 | ;;;_ > allout-new-item-widget () | ||
| 1501 | (defsubst allout-new-item-widget () | ||
| 1502 | "create a new item widget, not yet situated anywhere." | ||
| 1503 | (if allout-widgets-maintain-tally | ||
| 1504 | ;; all the extra overhead is incurred only when doing the | ||
| 1505 | ;; maintenance, except the condition, which can't be avoided. | ||
| 1506 | (let ((widget (widget-convert 'allout-item-widget))) | ||
| 1507 | (puthash widget nil allout-widgets-tally) | ||
| 1508 | widget) | ||
| 1509 | (widget-convert 'allout-item-widget))) | ||
| 1510 | ;;;_ : Item decoration | ||
| 1511 | ;;;_ > allout-decorate-item-and-context (item-widget &optional redecorate | ||
| 1512 | ;;; blank-container parent) | ||
| 1513 | (defun allout-decorate-item-and-context (item-widget &optional redecorate | ||
| 1514 | blank-container parent) | ||
| 1515 | "Create or adjust widget decorations for ITEM-WIDGET and neighbors at point. | ||
| 1516 | |||
| 1517 | The neighbors include its siblings and parent. | ||
| 1518 | |||
| 1519 | ITEM-WIDGET can be a created or converted allout-item-widget. | ||
| 1520 | |||
| 1521 | If you're only trying to get or create a widget for an item, use | ||
| 1522 | `allout-get-or-create-item-widget'. If you have the item-widget, applying | ||
| 1523 | :redecorate will do the right thing. | ||
| 1524 | |||
| 1525 | Optional BLANK-CONTAINER is for internal use. It is used to fabricate a | ||
| 1526 | container widget for an empty-bodied container, in the course of decorating | ||
| 1527 | a proper \(non-container\) item which starts at the beginning of the file. | ||
| 1528 | |||
| 1529 | Optional REDECORATE causes redecoration of the item-widget and | ||
| 1530 | its siblings, even if already decorated in this cycle of the command loop. | ||
| 1531 | |||
| 1532 | Optional PARENT, when provided, bypasses some navigation and computation | ||
| 1533 | necessary to obtain the parent of the items being processed. | ||
| 1534 | |||
| 1535 | We return the item-widget corresponding to the item at point." | ||
| 1536 | |||
| 1537 | (when (or redecorate | ||
| 1538 | (not (equal (widget-get item-widget :last-decorated-tick) | ||
| 1539 | allout-command-counter))) | ||
| 1540 | (let* ((allout-inhibit-body-modification-hook t) | ||
| 1541 | (was-modified (buffer-modified-p)) | ||
| 1542 | (was-point (point)) | ||
| 1543 | prefix-start | ||
| 1544 | (is-container (or blank-container | ||
| 1545 | (not (setq prefix-start (allout-goto-prefix))) | ||
| 1546 | (< was-point prefix-start))) | ||
| 1547 | ;; steady-point (set in two steps) is reliable across parent | ||
| 1548 | ;; widget-creation. | ||
| 1549 | (steady-point (progn (if is-container (goto-char 1)) | ||
| 1550 | (point-marker))) | ||
| 1551 | (steady-point (progn (set-marker-insertion-type steady-point t) | ||
| 1552 | steady-point)) | ||
| 1553 | (parent (and (not is-container) | ||
| 1554 | (allout-get-or-create-parent-widget))) | ||
| 1555 | parent-flags parent-depth | ||
| 1556 | successor-sibling | ||
| 1557 | body | ||
| 1558 | doing-item | ||
| 1559 | sub-item-widget | ||
| 1560 | depth | ||
| 1561 | reverse-siblings-chart | ||
| 1562 | (buffer-undo-list t)) | ||
| 1563 | |||
| 1564 | ;; At this point the parent is decorated and parent-flags indicate | ||
| 1565 | ;; its guide lines. We will iterate over the siblings according to a | ||
| 1566 | ;; chart we create at the start, and going from last to first so we | ||
| 1567 | ;; don't have to worry about text displacement caused by widgetizing. | ||
| 1568 | |||
| 1569 | (if is-container | ||
| 1570 | (progn (widget-put item-widget :is-container t) | ||
| 1571 | (setq reverse-siblings-chart (list 1))) | ||
| 1572 | (goto-char (widget-apply parent :actual-position :from)) | ||
| 1573 | (if (widget-get parent :is-container) | ||
| 1574 | ;; `allout-goto-prefix' will go to first non-container item: | ||
| 1575 | (allout-goto-prefix) | ||
| 1576 | (allout-next-heading)) | ||
| 1577 | (setq depth (allout-recent-depth)) | ||
| 1578 | (setq reverse-siblings-chart (list allout-recent-prefix-beginning)) | ||
| 1579 | (while (allout-next-sibling) | ||
| 1580 | (push allout-recent-prefix-beginning reverse-siblings-chart))) | ||
| 1581 | |||
| 1582 | (dolist (doing-at reverse-siblings-chart) | ||
| 1583 | (goto-char doing-at) | ||
| 1584 | (when allout-widgets-track-decoration | ||
| 1585 | (sit-for 0)) | ||
| 1586 | |||
| 1587 | (setq doing-item (if (= doing-at steady-point) | ||
| 1588 | item-widget | ||
| 1589 | (or (allout-get-item-widget) | ||
| 1590 | (allout-new-item-widget)))) | ||
| 1591 | |||
| 1592 | (when (or redecorate (not (equal (widget-get doing-item | ||
| 1593 | :last-decorated-tick) | ||
| 1594 | allout-command-counter))) | ||
| 1595 | (widget-apply doing-item :parse-item t blank-container) | ||
| 1596 | (widget-apply doing-item :decorate-item-span) | ||
| 1597 | |||
| 1598 | (widget-apply doing-item :decorate-guides | ||
| 1599 | parent (and successor-sibling t)) | ||
| 1600 | (widget-apply doing-item :decorate-icon) | ||
| 1601 | (widget-apply doing-item :decorate-cue) | ||
| 1602 | (widget-apply doing-item :decorate-body) | ||
| 1603 | |||
| 1604 | (widget-put doing-item :last-decorated-tick allout-command-counter)) | ||
| 1605 | |||
| 1606 | (setq successor-sibling doing-at)) | ||
| 1607 | |||
| 1608 | (set-buffer-modified-p was-modified) | ||
| 1609 | (goto-char steady-point) | ||
| 1610 | ;; must null the marker or the buffer gets clogged with impedence: | ||
| 1611 | (set-marker steady-point nil) | ||
| 1612 | |||
| 1613 | item-widget))) | ||
| 1614 | ;;;_ > allout-redecorate-item (item) | ||
| 1615 | (defun allout-redecorate-item (item-widget) | ||
| 1616 | "Resituate ITEM-WIDGET decorations, disregarding context. | ||
| 1617 | |||
| 1618 | Use this to redecorate only the item, when you know that it's | ||
| 1619 | situation with respect to siblings, parent, and offspring is | ||
| 1620 | unchanged from its last decoration. Use | ||
| 1621 | `allout-decorate-item-and-context' instead to reassess and adjust | ||
| 1622 | relevent context, when suitable." | ||
| 1623 | (if (not (equal (widget-get item-widget :last-decorated-tick) | ||
| 1624 | allout-command-counter)) | ||
| 1625 | (let ((was-modified (buffer-modified-p)) | ||
| 1626 | (buffer-undo-list t)) | ||
| 1627 | (widget-apply item-widget :parse-item) | ||
| 1628 | (widget-apply item-widget :decorate-guides) | ||
| 1629 | (widget-apply item-widget :decorate-icon) | ||
| 1630 | (widget-apply item-widget :decorate-cue) | ||
| 1631 | (widget-apply item-widget :decorate-body) | ||
| 1632 | (set-buffer-modified-p was-modified)))) | ||
| 1633 | ;;;_ > allout-redecorate-visible-subtree (&optional parent-widget | ||
| 1634 | ;;; depth chart) | ||
| 1635 | (defun allout-redecorate-visible-subtree (&optional parent-widget depth chart) | ||
| 1636 | "Redecorate all visible items in subtree at point. | ||
| 1637 | |||
| 1638 | Optional PARENT-WIDGET is for optimization, when the parent | ||
| 1639 | widget is already available. | ||
| 1640 | |||
| 1641 | Optional DEPTH restricts the excursion depth of covered. | ||
| 1642 | |||
| 1643 | Optional CHART is for internal recursion, to carry a chart of the | ||
| 1644 | target items. | ||
| 1645 | |||
| 1646 | Point is left at the last sibling in the visible subtree." | ||
| 1647 | ;; using a treatment that takes care of all the siblings on a level, we | ||
| 1648 | ;; only need apply it to the first sibling on the level, and we can | ||
| 1649 | ;; collect and pass the parent of the lower levels to recursive calls as | ||
| 1650 | ;; we go. | ||
| 1651 | (let ((parent-widget | ||
| 1652 | (if (and parent-widget (widget-apply parent-widget | ||
| 1653 | :actual-position :from)) | ||
| 1654 | (progn (goto-char (widget-apply parent-widget | ||
| 1655 | :actual-position :from)) | ||
| 1656 | parent-widget) | ||
| 1657 | (let ((got (allout-get-item-widget))) | ||
| 1658 | (if got | ||
| 1659 | (allout-decorate-item-and-context got 'redecorate) | ||
| 1660 | (allout-get-or-create-item-widget 'redecorate))))) | ||
| 1661 | (pending-chart (or chart (allout-chart-subtree nil 'visible))) | ||
| 1662 | item-widget | ||
| 1663 | previous-sibling-point | ||
| 1664 | previous-sibling | ||
| 1665 | recent-sibling-point) | ||
| 1666 | (setq pending-chart (nreverse pending-chart)) | ||
| 1667 | (dolist (sibling-point pending-chart) | ||
| 1668 | (cond ((integerp sibling-point) | ||
| 1669 | (when (not previous-sibling-point) | ||
| 1670 | (goto-char sibling-point) | ||
| 1671 | (if (setq item-widget (allout-get-item-widget nil)) | ||
| 1672 | (allout-decorate-item-and-context item-widget 'redecorate | ||
| 1673 | nil parent-widget) | ||
| 1674 | (allout-get-or-create-item-widget))) | ||
| 1675 | (setq previous-sibling-point sibling-point | ||
| 1676 | recent-sibling-point sibling-point)) | ||
| 1677 | ((listp sibling-point) | ||
| 1678 | (if (or (not depth) | ||
| 1679 | (> depth 1)) | ||
| 1680 | (allout-redecorate-visible-subtree | ||
| 1681 | (if (not previous-sibling-point) | ||
| 1682 | ;; containment discontinuity - sigh | ||
| 1683 | parent-widget | ||
| 1684 | (allout-get-or-create-item-widget 'redecorate)) | ||
| 1685 | (if depth (1- depth)) | ||
| 1686 | sibling-point))))) | ||
| 1687 | (if (and recent-sibling-point (< (point) recent-sibling-point)) | ||
| 1688 | (goto-char recent-sibling-point)))) | ||
| 1689 | ;;;_ > allout-parse-item-at-point (item-widget &optional at-beginning | ||
| 1690 | ;;; blank-container) | ||
| 1691 | (defun allout-parse-item-at-point (item-widget &optional at-beginning | ||
| 1692 | blank-container) | ||
| 1693 | "Set widget ITEM-WIDGET layout parameters per item-at-point's actual layout. | ||
| 1694 | |||
| 1695 | If optional AT-BEGINNING is t, then point is assumed to be at the start of | ||
| 1696 | the item prefix. | ||
| 1697 | |||
| 1698 | If optional BLANK-CONTAINER is true, then the parameters of a container | ||
| 1699 | which has an empty body are set. \(Though the body is blank, the object | ||
| 1700 | may have subitems.\)" | ||
| 1701 | |||
| 1702 | ;; Uncomment this sit-for to notice where decoration is happening: | ||
| 1703 | ;; (sit-for .1) | ||
| 1704 | (let* ((depth (allout-depth)) | ||
| 1705 | (depth (if blank-container 0 depth)) | ||
| 1706 | (is-container (or blank-container (zerop depth))) | ||
| 1707 | |||
| 1708 | (does-encrypt (and (not is-container) | ||
| 1709 | (allout-encrypted-type-prefix))) | ||
| 1710 | (is-encrypted (and does-encrypt (allout-encrypted-topic-p))) | ||
| 1711 | (icon-end allout-recent-prefix-end) | ||
| 1712 | (icon-start (1- icon-end)) | ||
| 1713 | body-start | ||
| 1714 | body-end | ||
| 1715 | bullet | ||
| 1716 | has-subitems | ||
| 1717 | (contents-depth (1+ depth)) | ||
| 1718 | ) | ||
| 1719 | (widget-put item-widget :depth depth) | ||
| 1720 | (if is-container | ||
| 1721 | |||
| 1722 | (progn | ||
| 1723 | (widget-put item-widget :from (allout-set-boundary-marker | ||
| 1724 | :from (point-min) | ||
| 1725 | (widget-get item-widget :from))) | ||
| 1726 | (widget-put item-widget :icon-end nil) | ||
| 1727 | (widget-put item-widget :icon-start nil) | ||
| 1728 | (setq body-start (widget-put item-widget :body-start 1))) | ||
| 1729 | |||
| 1730 | ;; not container: | ||
| 1731 | |||
| 1732 | (widget-put item-widget :from (allout-set-boundary-marker | ||
| 1733 | :from (if at-beginning | ||
| 1734 | (point) | ||
| 1735 | allout-recent-prefix-beginning) | ||
| 1736 | (widget-get item-widget :from))) | ||
| 1737 | (widget-put item-widget :icon-start icon-start) | ||
| 1738 | (widget-put item-widget :icon-end icon-end) | ||
| 1739 | (when does-encrypt | ||
| 1740 | (widget-put item-widget :does-encrypt t) | ||
| 1741 | (widget-put item-widget :is-encrypted is-encrypted)) | ||
| 1742 | |||
| 1743 | ;; cue area: | ||
| 1744 | (setq body-start icon-end) | ||
| 1745 | (widget-put item-widget :bullet (setq bullet (allout-get-bullet))) | ||
| 1746 | (if (equal (char-after body-start) ? ) | ||
| 1747 | (setq body-start (1+ body-start))) | ||
| 1748 | (widget-put item-widget :body-start body-start) | ||
| 1749 | ) | ||
| 1750 | |||
| 1751 | ;; Both container and regular items: | ||
| 1752 | |||
| 1753 | ;; :body-end (doesn't include a trailing blank line, if any) - | ||
| 1754 | (widget-put item-widget :body-end (setq body-end | ||
| 1755 | (if blank-container | ||
| 1756 | 1 | ||
| 1757 | (allout-end-of-entry)))) | ||
| 1758 | |||
| 1759 | (widget-put item-widget :to (allout-set-boundary-marker | ||
| 1760 | :to (if blank-container | ||
| 1761 | (point-min) | ||
| 1762 | (or (allout-pre-next-prefix) | ||
| 1763 | (goto-char (point-max)))) | ||
| 1764 | (widget-get item-widget :to))) | ||
| 1765 | (widget-put item-widget :has-subitems | ||
| 1766 | (setq has-subitems | ||
| 1767 | (and | ||
| 1768 | ;; has a subsequent item: | ||
| 1769 | (not (= body-end (point-max))) | ||
| 1770 | ;; subsequent item is deeper: | ||
| 1771 | (< depth (setq contents-depth (allout-recent-depth)))))) | ||
| 1772 | ;; note :expanded - true if widget item's content is currently visible? | ||
| 1773 | (widget-put item-widget :expanded | ||
| 1774 | (and has-subitems | ||
| 1775 | ;; subsequent item is or isn't visible: | ||
| 1776 | (save-excursion | ||
| 1777 | (goto-char allout-recent-prefix-beginning) | ||
| 1778 | (not (allout-hidden-p))))))) | ||
| 1779 | ;;;_ > allout-set-boundary-marker (boundary position &optional current-marker) | ||
| 1780 | (defun allout-set-boundary-marker (boundary position &optional current-marker) | ||
| 1781 | "Set or create item widget BOUNDARY type marker at POSITION. | ||
| 1782 | |||
| 1783 | Optional CURRENT-MARKER is the marker currently being used for | ||
| 1784 | the boundary, if any. | ||
| 1785 | |||
| 1786 | BOUNDARY type is either :from or :to, determining the marker insertion type." | ||
| 1787 | (if (not position) (setq position (point))) | ||
| 1788 | (if current-marker | ||
| 1789 | (set-marker current-marker position) | ||
| 1790 | (let ((marker (make-marker))) | ||
| 1791 | ;; XXX dang - would like for :from boundary to advance after inserted | ||
| 1792 | ;; text, but that would omit new header prefixes when allout | ||
| 1793 | ;; relevels, etc. this competes with ad-hoc edits, which would | ||
| 1794 | ;; better be omitted | ||
| 1795 | (set-marker-insertion-type marker nil) | ||
| 1796 | (set-marker marker position)))) | ||
| 1797 | ;;;_ > allout-decorate-item-span (item-widget) | ||
| 1798 | (defun allout-decorate-item-span (item-widget) | ||
| 1799 | "Equip the item with a span, as an entirety. | ||
| 1800 | |||
| 1801 | This span is implemented so it can be used to detect displacement | ||
| 1802 | of the widget in absolute terms, and provides an offset bias for | ||
| 1803 | the various element spans." | ||
| 1804 | |||
| 1805 | (if (and (widget-get item-widget :is-container) | ||
| 1806 | ;; the only case where the span could be empty. | ||
| 1807 | (eq (widget-get item-widget :from) | ||
| 1808 | (widget-get item-widget :to))) | ||
| 1809 | nil | ||
| 1810 | (allout-item-span item-widget | ||
| 1811 | (widget-get item-widget :from) | ||
| 1812 | (widget-get item-widget :to)))) | ||
| 1813 | ;;;_ > allout-decorate-item-guides (item-widget | ||
| 1814 | ;;; &optional parent-widget has-successor) | ||
| 1815 | (defun allout-decorate-item-guides (item-widget | ||
| 1816 | &optional parent-widget has-successor) | ||
| 1817 | "Add ITEM-WIDGET guide icon-prefix descender and connector text properties. | ||
| 1818 | |||
| 1819 | Optional arguments provide context for deriving the guides. In | ||
| 1820 | their absence, the current guide column flags are used. | ||
| 1821 | |||
| 1822 | Optional PARENT-WIDGET is the widget for the item's parent item. | ||
| 1823 | |||
| 1824 | Optional HAS-SUCCESSOR is true iff the item is followed by a sibling. | ||
| 1825 | |||
| 1826 | We also hide the header-prefix string. | ||
| 1827 | |||
| 1828 | Guides are established according to the item-widget's :guide-column-flags, | ||
| 1829 | when different than :was-guide-column-flags. Changing that property and | ||
| 1830 | reapplying this method will rectify the glyphs." | ||
| 1831 | |||
| 1832 | (when (not (widget-get item-widget :is-container)) | ||
| 1833 | (let* ((depth (widget-get item-widget :depth)) | ||
| 1834 | (parent-depth (and parent-widget | ||
| 1835 | (widget-get parent-widget :depth))) | ||
| 1836 | (parent-flags (and parent-widget | ||
| 1837 | (widget-get parent-widget :guide-column-flags))) | ||
| 1838 | (parent-flags-depth (length parent-flags)) | ||
| 1839 | (extender-length (- depth (+ parent-flags-depth 2))) | ||
| 1840 | (flags (or (and (> depth 1) | ||
| 1841 | parent-widget | ||
| 1842 | (widget-put item-widget :guide-column-flags | ||
| 1843 | (append (list has-successor) | ||
| 1844 | (if (< 0 extender-length) | ||
| 1845 | (make-list extender-length | ||
| 1846 | '-)) | ||
| 1847 | parent-flags))) | ||
| 1848 | (widget-get item-widget :guide-column-flags))) | ||
| 1849 | (was-flags (widget-get item-widget :was-guide-column-flags)) | ||
| 1850 | (guides-start (widget-get item-widget :from)) | ||
| 1851 | (guides-end (widget-get item-widget :icon-start)) | ||
| 1852 | (position guides-start) | ||
| 1853 | (increment (length allout-header-prefix)) | ||
| 1854 | reverse-flags | ||
| 1855 | guide-name | ||
| 1856 | extenders paint-extenders | ||
| 1857 | (inhibit-read-only t)) | ||
| 1858 | |||
| 1859 | (when (not (equal was-flags flags)) | ||
| 1860 | |||
| 1861 | (setq reverse-flags (reverse flags)) | ||
| 1862 | (while reverse-flags | ||
| 1863 | (setq guide-name | ||
| 1864 | (cond ((null (cdr reverse-flags)) | ||
| 1865 | (if (car reverse-flags) | ||
| 1866 | 'mid-connector | ||
| 1867 | 'end-connector)) | ||
| 1868 | ((eq (car reverse-flags) '-) | ||
| 1869 | ;; accumulate extenders tally, to be painted on next | ||
| 1870 | ;; non-extender flag, according to the flag type. | ||
| 1871 | (setq extenders (1+ (or extenders 0))) | ||
| 1872 | nil) | ||
| 1873 | ((car reverse-flags) | ||
| 1874 | 'through-descender) | ||
| 1875 | (t 'skip-descender))) | ||
| 1876 | (when guide-name | ||
| 1877 | (put-text-property position (setq position (+ position increment)) | ||
| 1878 | 'display (allout-fetch-icon-image guide-name)) | ||
| 1879 | (if (> increment 1) (setq increment 1)) | ||
| 1880 | (when extenders | ||
| 1881 | ;; paint extenders after a connector, else leave spaces. | ||
| 1882 | (dotimes (i extenders) | ||
| 1883 | (put-text-property | ||
| 1884 | position (setq position (1+ position)) | ||
| 1885 | 'display (allout-fetch-icon-image | ||
| 1886 | (if (memq guide-name '(mid-connector end-connector)) | ||
| 1887 | 'extender-connector | ||
| 1888 | 'skip-descender)))) | ||
| 1889 | (setq extenders nil))) | ||
| 1890 | (setq reverse-flags (cdr reverse-flags))) | ||
| 1891 | (widget-put item-widget :was-guide-column-flags flags)) | ||
| 1892 | |||
| 1893 | (allout-item-element-span-is item-widget :guides-span | ||
| 1894 | guides-start guides-end)))) | ||
| 1895 | ;;;_ > allout-decorate-item-icon (item-widget) | ||
| 1896 | (defun allout-decorate-item-icon (item-widget) | ||
| 1897 | "Add item icon glyph and distinctive bullet text properties to ITEM-WIDGET." | ||
| 1898 | |||
| 1899 | (when (not (widget-get item-widget :is-container)) | ||
| 1900 | (let* ((icon-start (widget-get item-widget :icon-start)) | ||
| 1901 | (icon-end (widget-get item-widget :icon-end)) | ||
| 1902 | (bullet (widget-get item-widget :bullet)) | ||
| 1903 | (use-bullet bullet) | ||
| 1904 | (was-bullet (widget-get item-widget :was-bullet)) | ||
| 1905 | (distinctive (allout-distinctive-bullet bullet)) | ||
| 1906 | (distinctive-start (widget-get item-widget :distinctive-start)) | ||
| 1907 | (distinctive-end (widget-get item-widget :distinctive-end)) | ||
| 1908 | (does-encrypt (widget-get item-widget :does-encrypt)) | ||
| 1909 | (is-encrypted (and does-encrypt (widget-get item-widget | ||
| 1910 | :is-encrypted))) | ||
| 1911 | (expanded (widget-get item-widget :expanded)) | ||
| 1912 | (has-subitems (widget-get item-widget :has-subitems)) | ||
| 1913 | (inhibit-read-only t) | ||
| 1914 | icon-state) | ||
| 1915 | |||
| 1916 | (when (not (and (equal (widget-get item-widget :was-expanded) expanded) | ||
| 1917 | (equal (widget-get item-widget :was-has-subitems) | ||
| 1918 | has-subitems) | ||
| 1919 | (equal (widget-get item-widget :was-does-encrypt) | ||
| 1920 | does-encrypt) | ||
| 1921 | (equal (widget-get item-widget :was-is-encrypted) | ||
| 1922 | is-encrypted))) | ||
| 1923 | |||
| 1924 | (setq icon-state | ||
| 1925 | (cond (does-encrypt (if is-encrypted | ||
| 1926 | 'locked-encrypted | ||
| 1927 | 'unlocked-encrypted)) | ||
| 1928 | (expanded 'opened) | ||
| 1929 | (has-subitems 'closed) | ||
| 1930 | (t 'empty))) | ||
| 1931 | (put-text-property icon-start (1+ icon-start) | ||
| 1932 | 'display (allout-fetch-icon-image icon-state)) | ||
| 1933 | (widget-put item-widget :was-expanded expanded) | ||
| 1934 | (widget-put item-widget :was-has-subitems has-subitems) | ||
| 1935 | (widget-put item-widget :was-does-encrypt does-encrypt) | ||
| 1936 | (widget-put item-widget :was-is-encrypted is-encrypted) | ||
| 1937 | ;; preserve as a widget property to track last known: | ||
| 1938 | (widget-put item-widget :icon-state icon-state) | ||
| 1939 | ;; preserve as a text property to track undo: | ||
| 1940 | (put-text-property icon-start icon-end :icon-state icon-state)) | ||
| 1941 | (allout-item-element-span-is item-widget :icon-span | ||
| 1942 | icon-start icon-end) | ||
| 1943 | (when (not (string= was-bullet bullet)) | ||
| 1944 | (cond ((not distinctive) | ||
| 1945 | ;; XXX we strip the prior properties without even checking if | ||
| 1946 | ;; the prior bullet was distinctive, because the widget | ||
| 1947 | ;; provisions to convey that info is disappearing, sigh. | ||
| 1948 | (remove-text-properties icon-end (1+ icon-end) '(display)) | ||
| 1949 | (setq distinctive-start icon-end distinctive-end icon-end) | ||
| 1950 | (widget-put item-widget :distinctive-start distinctive-start) | ||
| 1951 | (widget-put item-widget :distinctive-end distinctive-end)) | ||
| 1952 | |||
| 1953 | ((not (string= bullet allout-numbered-bullet)) | ||
| 1954 | (setq distinctive-start icon-end distinctive-end (+ icon-end 1))) | ||
| 1955 | |||
| 1956 | (does-encrypt | ||
| 1957 | (setq distinctive-start icon-end distinctive-end (+ icon-end 1))) | ||
| 1958 | |||
| 1959 | (t | ||
| 1960 | (goto-char icon-end) | ||
| 1961 | (looking-at "[0-9]+") | ||
| 1962 | (setq use-bullet (buffer-substring icon-end (match-end 0))) | ||
| 1963 | (setq distinctive-start icon-end | ||
| 1964 | distinctive-end (match-end 0)))) | ||
| 1965 | (put-text-property distinctive-start distinctive-end 'display | ||
| 1966 | use-bullet) | ||
| 1967 | (widget-put item-widget :was-bullet bullet) | ||
| 1968 | (widget-put item-widget :distinctive-start distinctive-start) | ||
| 1969 | (widget-put item-widget :distinctive-end distinctive-end))))) | ||
| 1970 | ;;;_ > allout-decorate-item-cue (item-widget) | ||
| 1971 | (defun allout-decorate-item-cue (item-widget) | ||
| 1972 | "Incorporate space between bullet icon and body to the ITEM-WIDGET." | ||
| 1973 | ;; NOTE: most of the cue-area | ||
| 1974 | |||
| 1975 | (when (not (widget-get item-widget :is-container)) | ||
| 1976 | (let* ((cue-start (or (widget-get item-widget :distinctive-end) | ||
| 1977 | (widget-get item-widget :icon-end))) | ||
| 1978 | (body-start (widget-get item-widget :body-start)) | ||
| 1979 | (expanded (widget-get item-widget :expanded)) | ||
| 1980 | (has-subitems (widget-get item-widget :has-subitems)) | ||
| 1981 | (inhibit-read-only t)) | ||
| 1982 | |||
| 1983 | (allout-item-element-span-is item-widget :cue-span cue-start body-start) | ||
| 1984 | (put-text-property (1- body-start) body-start 'rear-nonsticky t)))) | ||
| 1985 | ;;;_ > allout-decorate-item-body (item-widget &optional force) | ||
| 1986 | (defun allout-decorate-item-body (item-widget &optional force) | ||
| 1987 | "Incorporate item body text as part the ITEM-WIDGET. | ||
| 1988 | |||
| 1989 | Optional FORCE means force reassignment of the region property." | ||
| 1990 | |||
| 1991 | (let* ((allout-inhibit-body-modification-hook t) | ||
| 1992 | (body-start (widget-get item-widget :body-start)) | ||
| 1993 | (body-end (widget-get item-widget :body-end)) | ||
| 1994 | (body-text-end body-end) | ||
| 1995 | (inhibit-read-only t)) | ||
| 1996 | |||
| 1997 | (allout-item-element-span-is item-widget :body-span | ||
| 1998 | body-start (min (1+ body-end) (point-max)) | ||
| 1999 | force))) | ||
| 2000 | ;;;_ > allout-item-actual-position (item-widget field) | ||
| 2001 | (defun allout-item-actual-position (item-widget field) | ||
| 2002 | "Return ITEM-WIDGET FIELD position taking item displacement into account." | ||
| 2003 | |||
| 2004 | ;; The item's sub-element positions (:icon-end, :body-start, etc) are | ||
| 2005 | ;; accurate when the item is parsed, but some offsets from the start | ||
| 2006 | ;; drift with text added in the body. | ||
| 2007 | ;; | ||
| 2008 | ;; Rather than reparse an item with every change (inefficient), or derive | ||
| 2009 | ;; every position from a distinct field marker/overlay (prohibitive as | ||
| 2010 | ;; the number of items grows), we use the displacement tracking of the | ||
| 2011 | ;; :span-overlay's markers, against the registered :from or :body-end | ||
| 2012 | ;; (depending on whether the requested field value is before or after the | ||
| 2013 | ;; item body), to bias the registered values. | ||
| 2014 | ;; | ||
| 2015 | ;; This is not necessary/useful when the item is being decorated, because | ||
| 2016 | ;; that always must be preceeded by a fresh item parse. | ||
| 2017 | |||
| 2018 | (if (not (eq field :body-end)) | ||
| 2019 | (widget-get item-widget :from) | ||
| 2020 | |||
| 2021 | (let* ((span-overlay (widget-get item-widget :span-overlay)) | ||
| 2022 | (body-end-position (widget-get item-widget :body-end)) | ||
| 2023 | (ref-marker-position (and span-overlay | ||
| 2024 | (overlay-end span-overlay))) | ||
| 2025 | (offset (and body-end-position span-overlay | ||
| 2026 | (- (or ref-marker-position 0) | ||
| 2027 | body-end-position)))) | ||
| 2028 | (+ (widget-get item-widget field) (or offset 0))))) | ||
| 2029 | ;;;_ : Item undecoration | ||
| 2030 | ;;;_ > allout-widgets-undecorate-region (start end) | ||
| 2031 | (defun allout-widgets-undecorate-region (start end) | ||
| 2032 | "Eliminate widgets and decorations for all items in region from START to END." | ||
| 2033 | (let ((next start) | ||
| 2034 | widget) | ||
| 2035 | (save-excursion | ||
| 2036 | (goto-char start) | ||
| 2037 | (while (< (setq next (next-single-char-property-change next | ||
| 2038 | 'display | ||
| 2039 | (current-buffer) | ||
| 2040 | end)) | ||
| 2041 | end) | ||
| 2042 | (goto-char next) | ||
| 2043 | (when (setq widget (allout-get-item-widget)) | ||
| 2044 | ;; if the next-property/overly progression got us to a widget: | ||
| 2045 | (allout-widgets-undecorate-item widget t)))))) | ||
| 2046 | ;;;_ > allout-widgets-undecorate-text (text) | ||
| 2047 | (defun allout-widgets-undecorate-text (text) | ||
| 2048 | "Eliminate widgets and decorations for all items in TEXT." | ||
| 2049 | (remove-text-properties 0 (length text) | ||
| 2050 | '(display nil :icon-state nil rear-nonsticky nil | ||
| 2051 | category nil button nil field nil) | ||
| 2052 | text) | ||
| 2053 | text) | ||
| 2054 | ;;;_ > allout-widgets-undecorate-item (item-widget &optional no-expose) | ||
| 2055 | (defun allout-widgets-undecorate-item (item-widget &optional no-expose) | ||
| 2056 | "Remove widget decorations from ITEM-WIDGET. | ||
| 2057 | |||
| 2058 | Any concealed content head lines and item body is exposed, unless | ||
| 2059 | optional NO-EXPOSE is non-nil." | ||
| 2060 | (let ((from (widget-get item-widget :from)) | ||
| 2061 | (to (widget-get item-widget :to)) | ||
| 2062 | (text-properties-to-remove '(display nil | ||
| 2063 | :icon-state nil | ||
| 2064 | rear-nonsticky nil | ||
| 2065 | category nil | ||
| 2066 | button nil | ||
| 2067 | field nil)) | ||
| 2068 | (span-overlay (widget-get item-widget :span-overlay)) | ||
| 2069 | (button-overlay (widget-get item-widget :button)) | ||
| 2070 | (was-modified (buffer-modified-p)) | ||
| 2071 | (buffer-undo-list t) | ||
| 2072 | (inhibit-read-only t)) | ||
| 2073 | (if (not no-expose) | ||
| 2074 | (allout-flag-region from to nil)) | ||
| 2075 | (allout-unprotected | ||
| 2076 | (remove-text-properties from to text-properties-to-remove)) | ||
| 2077 | (when span-overlay | ||
| 2078 | (delete-overlay span-overlay) (widget-put item-widget :span-overlay nil)) | ||
| 2079 | (when button-overlay | ||
| 2080 | (delete-overlay button-overlay) (widget-put item-widget :button nil)) | ||
| 2081 | (set-marker from nil) | ||
| 2082 | (set-marker to nil) | ||
| 2083 | (if (not was-modified) | ||
| 2084 | (set-buffer-modified-p nil)))) | ||
| 2085 | |||
| 2086 | ;;;_ : Item decoration support | ||
| 2087 | ;;;_ > allout-item-span (item-widget &optional start end) | ||
| 2088 | (defun allout-item-span (item-widget &optional start end) | ||
| 2089 | "Return or register the location of an ITEM-WIDGET's actual START and END. | ||
| 2090 | |||
| 2091 | If START and END are not passed in, return either a dotted pair | ||
| 2092 | of the current span, if established, or nil if not yet set. | ||
| 2093 | |||
| 2094 | When the START and END are passed, return the distance that the | ||
| 2095 | start of the item moved. We return 0 if the span was not | ||
| 2096 | previously established or is not moved." | ||
| 2097 | (let ((overlay (widget-get item-widget :span-overlay)) | ||
| 2098 | was-start was-end | ||
| 2099 | changed) | ||
| 2100 | (cond ((not overlay) (when start | ||
| 2101 | (setq overlay (make-overlay start end nil t nil)) | ||
| 2102 | (overlay-put overlay 'button item-widget) | ||
| 2103 | (widget-put item-widget :span-overlay overlay) | ||
| 2104 | t)) | ||
| 2105 | ;; report: | ||
| 2106 | ((not start) (cons (overlay-start overlay) (overlay-end overlay))) | ||
| 2107 | ;; move: | ||
| 2108 | ((or (not (equal (overlay-start overlay) start)) | ||
| 2109 | (not (equal (overlay-end overlay) end))) | ||
| 2110 | (move-overlay overlay start end) | ||
| 2111 | t) | ||
| 2112 | ;; specified span already set: | ||
| 2113 | (t nil)))) | ||
| 2114 | ;;;_ > allout-item-element-span-is (item-widget element | ||
| 2115 | ;;; &optional start end force) | ||
| 2116 | (defun allout-item-element-span-is (item-widget element | ||
| 2117 | &optional start end force) | ||
| 2118 | "Return or register the location of the indicated ITEM-WIDGET ELEMENT. | ||
| 2119 | |||
| 2120 | ELEMENT is one of :guides-span, :icon-span, :cue-span, or :body-span. | ||
| 2121 | |||
| 2122 | When optional START is specified, optional END must also be. | ||
| 2123 | |||
| 2124 | START and END are the actual bounds of the region, if provided. | ||
| 2125 | |||
| 2126 | If START and END are not passed in, we return either a dotted | ||
| 2127 | pair of the current span, if established, or nil if not yet set. | ||
| 2128 | |||
| 2129 | When the START and END are passed, we return t if the region | ||
| 2130 | changed or nil if not. | ||
| 2131 | |||
| 2132 | Optional FORCE means force assignment of the region's text | ||
| 2133 | property, even if it's already set." | ||
| 2134 | (let ((span (widget-get item-widget element))) | ||
| 2135 | (cond ((or (not span) force) | ||
| 2136 | (when start | ||
| 2137 | (widget-put item-widget element (cons start end)) | ||
| 2138 | (put-text-property start end 'category | ||
| 2139 | (cdr (assoc element | ||
| 2140 | allout-span-to-category))) | ||
| 2141 | t)) | ||
| 2142 | ;; report: | ||
| 2143 | ((not start) span) | ||
| 2144 | ;; move if necessary: | ||
| 2145 | ((not (and (eq (car span) start) | ||
| 2146 | (eq (cdr span) end))) | ||
| 2147 | (widget-put item-widget element span) | ||
| 2148 | t) | ||
| 2149 | ;; specified span already set: | ||
| 2150 | (t nil)))) | ||
| 2151 | ;;;_ : Item widget retrieval (/ high-level creation): | ||
| 2152 | ;;;_ > allout-get-item-widget (&optional container) | ||
| 2153 | (defun allout-get-item-widget (&optional container) | ||
| 2154 | "Return the widget for the item at point, or nil if no widget yet exists. | ||
| 2155 | |||
| 2156 | Point must be situated *before* the start of the target item's | ||
| 2157 | body, so we don't get an existing containing item when we're in | ||
| 2158 | the process of creating an item in the middle of another. | ||
| 2159 | |||
| 2160 | Optional CONTAINER is used to obtain the container item." | ||
| 2161 | (if (or container (zerop (allout-depth))) | ||
| 2162 | allout-container-item-widget | ||
| 2163 | ;; allout-recent-* are calibrated by (allout-depth) if we got here. | ||
| 2164 | (let ((got (widget-at allout-recent-prefix-beginning))) | ||
| 2165 | (if (and got (listp got)) | ||
| 2166 | (if (marker-position (widget-get got :from)) | ||
| 2167 | (and | ||
| 2168 | (>= (point) (widget-apply got :actual-position :from)) | ||
| 2169 | (<= (point) (widget-apply got :actual-position :body-start)) | ||
| 2170 | got) | ||
| 2171 | ;; a wacky residual item - undecorate and disregard: | ||
| 2172 | (allout-widgets-undecorate-item got) | ||
| 2173 | nil))))) | ||
| 2174 | ;;;_ > allout-get-or-create-item-widget (&optional redecorate blank-container) | ||
| 2175 | (defun allout-get-or-create-item-widget (&optional redecorate blank-container) | ||
| 2176 | "Return a widget for the item at point, creating the widget if necessary. | ||
| 2177 | |||
| 2178 | When creating a widget, we assume there has been a context change | ||
| 2179 | and decorate its siblings and parent, as well. | ||
| 2180 | |||
| 2181 | Optional BLANK-CONTAINER is for internal use, to fabricate a | ||
| 2182 | meta-container item with an empty body when the first proper | ||
| 2183 | \(non-container\) item starts at the beginning of the file. | ||
| 2184 | |||
| 2185 | Optional REDECORATE, if non-nil, means to redecorate the widget | ||
| 2186 | if it already exists." | ||
| 2187 | (let ((widget (allout-get-item-widget blank-container)) | ||
| 2188 | (buffer-undo-list t)) | ||
| 2189 | (cond (widget (if redecorate | ||
| 2190 | (allout-redecorate-item widget)) | ||
| 2191 | widget) | ||
| 2192 | ((or blank-container (zerop (allout-depth))) | ||
| 2193 | (or allout-container-item-widget | ||
| 2194 | (setq allout-container-item-widget | ||
| 2195 | (allout-decorate-item-and-context | ||
| 2196 | (widget-convert 'allout-item-widget) | ||
| 2197 | nil blank-container)))) | ||
| 2198 | ;; create a widget for a regular/non-container item: | ||
| 2199 | (t (allout-decorate-item-and-context (widget-convert | ||
| 2200 | 'allout-item-widget)))))) | ||
| 2201 | ;;;_ > allout-get-or-create-parent-widget (&optional redecorate) | ||
| 2202 | (defun allout-get-or-create-parent-widget (&optional redecorate) | ||
| 2203 | "Return widget for parent of item at point, decorating it if necessary. | ||
| 2204 | |||
| 2205 | We return the container widget if we're above the first proper item in the | ||
| 2206 | file. | ||
| 2207 | |||
| 2208 | Optional REDECORATE, if non-nil, means to redecorate the widget if it | ||
| 2209 | already exists. | ||
| 2210 | |||
| 2211 | Point will wind up positioned on the beginning of the parent or beginning | ||
| 2212 | of the buffer." | ||
| 2213 | ;; use existing widget, if there, else establish it | ||
| 2214 | (if (or (bobp) (and (not (allout-ascend)) | ||
| 2215 | (looking-at allout-regexp))) | ||
| 2216 | (allout-get-or-create-item-widget redecorate 'blank-container) | ||
| 2217 | (allout-get-or-create-item-widget redecorate))) | ||
| 2218 | ;;;_ : X- Item ancillaries | ||
| 2219 | ;;;_ >X allout-body-modification-handler (beg end) | ||
| 2220 | (defun allout-body-modification-handler (beg end) | ||
| 2221 | "Do routine processing of body text before and after modification. | ||
| 2222 | |||
| 2223 | Operation is inhibited by `allout-inhibit-body-modification-handler'." | ||
| 2224 | |||
| 2225 | ;; The primary duties are: | ||
| 2226 | ;; | ||
| 2227 | ;; - marking of escaped prefix-like text for delayed cleanup of escapes | ||
| 2228 | ;; - removal and replacement of the settings | ||
| 2229 | ;; - maintenance of beginning-of-line guide lines | ||
| 2230 | ;; | ||
| 2231 | ;; ?? Escapes removal \(before changes\) is not done when edits span multiple | ||
| 2232 | ;; items, recognizing that item structure is being preserved, including | ||
| 2233 | ;; escaping of item-prefix-like text within bodies. See | ||
| 2234 | ;; `allout-before-modification-handler' and | ||
| 2235 | ;; `allout-inhibit-body-modification-handler'. | ||
| 2236 | ;; | ||
| 2237 | ;; Adds the overlay to the `allout-unresolved-body-mod-workhash' during | ||
| 2238 | ;; before-change operation, and removes from that list during after-change | ||
| 2239 | ;; operation. | ||
| 2240 | (cond (allout-inhibit-body-modification-hook nil))) | ||
| 2241 | ;;;_ >X allout-graphics-modification-handler (beg end) | ||
| 2242 | (defun allout-graphics-modification-handler (beg end) | ||
| 2243 | "Protect against incoherent deletion of decoration graphics. | ||
| 2244 | |||
| 2245 | Deletes allowed only when inhibit-read-only is t." | ||
| 2246 | (cond | ||
| 2247 | (undo-in-progress (when (eq (get-text-property beg 'category) | ||
| 2248 | 'allout-icon-span-category) | ||
| 2249 | (save-excursion | ||
| 2250 | (goto-char beg) | ||
| 2251 | (let* ((item-widget (allout-get-item-widget))) | ||
| 2252 | (if item-widget | ||
| 2253 | (allout-widgets-exposure-undo-recorder | ||
| 2254 | item-widget)))))) | ||
| 2255 | (inhibit-read-only t) | ||
| 2256 | ((not (and (boundp 'allout-mode) allout-mode)) t) | ||
| 2257 | ((equal this-command 'quoted-insert) t) | ||
| 2258 | ((yes-or-no-p "Unruly edit of outline structure - allow? ") | ||
| 2259 | (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only) | ||
| 2260 | inhibit-read-only t)) | ||
| 2261 | (t (error | ||
| 2262 | (substitute-command-keys allout-structure-unruly-deletion-message))))) | ||
| 2263 | ;;;_ > allout-item-icon-key-handler () | ||
| 2264 | (defun allout-item-icon-key-handler () | ||
| 2265 | "Catchall handling of key bindings in item icon/cue hot-spots. | ||
| 2266 | |||
| 2267 | Applies `allout-hotspot-key-handler' and calls the result, if any, as an | ||
| 2268 | interactive command." | ||
| 2269 | |||
| 2270 | (interactive) | ||
| 2271 | (let* ((mapped-binding (allout-hotspot-key-handler))) | ||
| 2272 | (when mapped-binding | ||
| 2273 | (call-interactively mapped-binding)))) | ||
| 2274 | |||
| 2275 | ;;;_ : Status | ||
| 2276 | ;;;_ . allout-item-location (item-widget) | ||
| 2277 | (defun allout-item-location (item-widget) | ||
| 2278 | "Location of the start of the item's text." | ||
| 2279 | (overlay-start (widget-get item-widget :span-overlay))) | ||
| 2280 | |||
| 2281 | ;;;_ : Icon management | ||
| 2282 | ;;;_ > allout-fetch-icon-image (name) | ||
| 2283 | (defun allout-fetch-icon-image (name) | ||
| 2284 | "Fetch allout icon for symbol NAME. | ||
| 2285 | |||
| 2286 | We use a caching strategy, so the caller doesn't need to do so." | ||
| 2287 | (let* ((types allout-widgets-icon-types) | ||
| 2288 | (use-dir (if (equal (allout-frame-property nil 'background-mode) | ||
| 2289 | 'light) | ||
| 2290 | allout-widgets-icons-light-subdir | ||
| 2291 | allout-widgets-icons-dark-subdir)) | ||
| 2292 | (key (list name use-dir)) | ||
| 2293 | (got (assoc key allout-widgets-icons-cache))) | ||
| 2294 | (if got | ||
| 2295 | ;; display system shows only first of subsequent adjacent | ||
| 2296 | ;; `eq'-identical repeats - use copies to avoid this problem. | ||
| 2297 | (allout-widgets-copy-list (cadr got)) | ||
| 2298 | (while (and types (not got)) | ||
| 2299 | (setq got | ||
| 2300 | (allout-find-image | ||
| 2301 | (list (append (list :type (car types) | ||
| 2302 | :file (concat use-dir | ||
| 2303 | (symbol-name name) | ||
| 2304 | "." (symbol-name | ||
| 2305 | (car types)))) | ||
| 2306 | (if (featurep 'xemacs) | ||
| 2307 | allout-widgets-item-image-properties-xemacs | ||
| 2308 | allout-widgets-item-image-properties-emacs) | ||
| 2309 | )))) | ||
| 2310 | (setq types (cdr types))) | ||
| 2311 | (if got | ||
| 2312 | (push (list key got) allout-widgets-icons-cache)) | ||
| 2313 | got))) | ||
| 2314 | |||
| 2315 | ;;;_ : Miscellaneous | ||
| 2316 | ;;;_ > allout-elapsed-time-seconds (triple) | ||
| 2317 | (defun allout-elapsed-time-seconds (end start) | ||
| 2318 | "Return seconds between `current-time' style time START/END triples." | ||
| 2319 | (let ((elapsed (time-subtract end start))) | ||
| 2320 | (+ (* (car elapsed) (expt 2.0 16)) | ||
| 2321 | (cadr elapsed) | ||
| 2322 | (/ (caddr elapsed) (expt 10.0 6))))) | ||
| 2323 | ;;;_ > allout-frame-property (frame property) | ||
| 2324 | (defalias 'allout-frame-property | ||
| 2325 | (cond ((fboundp 'frame-parameter) | ||
| 2326 | 'frame-parameter) | ||
| 2327 | ((fboundp 'frame-property) | ||
| 2328 | 'frame-property) | ||
| 2329 | (t nil))) | ||
| 2330 | ;;;_ > allout-find-image (specs) | ||
| 2331 | (defalias 'allout-find-image | ||
| 2332 | (if (fboundp 'find-image) | ||
| 2333 | 'find-image | ||
| 2334 | nil) ; aka, not-yet-implemented for xemacs. | ||
| 2335 | ) | ||
| 2336 | ;;;_ > allout-widgets-copy-list (list) | ||
| 2337 | (defun allout-widgets-copy-list (list) | ||
| 2338 | ;; duplicated from cl.el 'copy-list' as of 2008-08-17 | ||
| 2339 | "Return a copy of LIST, which may be a dotted list. | ||
| 2340 | The elements of LIST are not copied, just the list structure itself." | ||
| 2341 | (if (consp list) | ||
| 2342 | (let ((res nil)) | ||
| 2343 | (while (consp list) (push (pop list) res)) | ||
| 2344 | (prog1 (nreverse res) (setcdr res list))) | ||
| 2345 | (car list))) | ||
| 2346 | |||
| 2347 | ;;;_ : Run unit tests: | ||
| 2348 | (defun allout-widgets-run-unit-tests () | ||
| 2349 | (message "Running allout-widget tests...") | ||
| 2350 | |||
| 2351 | (allout-test-range-overlaps) | ||
| 2352 | |||
| 2353 | (message "Running allout-widget tests... Done.") | ||
| 2354 | (sit-for .5)) | ||
| 2355 | |||
| 2356 | (when allout-widgets-run-unit-tests-on-load | ||
| 2357 | (allout-widgets-run-unit-tests)) | ||
| 2358 | |||
| 2359 | ;;;_ : provide | ||
| 2360 | (provide 'allout-widgets) | ||
| 2361 | |||
| 2362 | ;;;_. Local emacs vars. | ||
| 2363 | ;;;_ , Local variables: | ||
| 2364 | ;;;_ , allout-layout: (-1 : 0) | ||
| 2365 | ;;;_ , End: | ||
diff --git a/lisp/allout.el b/lisp/allout.el index 5d87415a57f..1a7d8cb1593 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -6,7 +6,7 @@ | |||
| 6 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> | 6 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> |
| 7 | ;; Created: Dec 1991 -- first release to usenet | 7 | ;; Created: Dec 1991 -- first release to usenet |
| 8 | ;; Version: 2.3 | 8 | ;; Version: 2.3 |
| 9 | ;; Keywords: outlines wp languages | 9 | ;; Keywords: outlines, wp, languages, PGP, GnuPG |
| 10 | ;; Website: http://myriadicity.net/Sundry/EmacsAllout | 10 | ;; Website: http://myriadicity.net/Sundry/EmacsAllout |
| 11 | 11 | ||
| 12 | ;; This file is part of GNU Emacs. | 12 | ;; This file is part of GNU Emacs. |
| @@ -39,11 +39,9 @@ | |||
| 39 | ;; emacs local file variables need to be enabled when the | 39 | ;; emacs local file variables need to be enabled when the |
| 40 | ;; file was visited -- see `enable-local-variables'.) | 40 | ;; file was visited -- see `enable-local-variables'.) |
| 41 | ;; - Configurable per-file initial exposure settings | 41 | ;; - Configurable per-file initial exposure settings |
| 42 | ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase | 42 | ;; - Symmetric-key and key-pair topic encryption. Encryption is via the |
| 43 | ;; mnemonic support, with verification against an established passphrase | 43 | ;; Emacs 'epg' library. See allout-toggle-current-subtree-encryption |
| 44 | ;; (using a stashed encrypted dummy string) and user-supplied hint | 44 | ;; docstring. |
| 45 | ;; maintenance. Encryption is via the Emacs 'epg' library. See | ||
| 46 | ;; allout-toggle-current-subtree-encryption docstring. | ||
| 47 | ;; - Automatic topic-number maintenance | 45 | ;; - Automatic topic-number maintenance |
| 48 | ;; - "Hot-spot" operation, for single-keystroke maneuvering and | 46 | ;; - "Hot-spot" operation, for single-keystroke maneuvering and |
| 49 | ;; exposure control (see the allout-mode docstring) | 47 | ;; exposure control (see the allout-mode docstring) |
| @@ -59,8 +57,8 @@ | |||
| 59 | ;; See the `allout-mode' function's docstring for an introduction to the | 57 | ;; See the `allout-mode' function's docstring for an introduction to the |
| 60 | ;; mode. | 58 | ;; mode. |
| 61 | ;; | 59 | ;; |
| 62 | ;; The latest development version and helpful notes are available at | 60 | ;; Directions to the latest development version and helpful notes are |
| 63 | ;; http://myriadicity.net/Sundry/EmacsAllout . | 61 | ;; available at http://myriadicity.net/Sundry/EmacsAllout . |
| 64 | ;; | 62 | ;; |
| 65 | ;; The outline menubar additions provide quick reference to many of the | 63 | ;; The outline menubar additions provide quick reference to many of the |
| 66 | ;; features. See the docstring of the variables `allout-layout' and | 64 | ;; features. See the docstring of the variables `allout-layout' and |
| @@ -76,7 +74,7 @@ | |||
| 76 | 74 | ||
| 77 | ;;; Code: | 75 | ;;; Code: |
| 78 | 76 | ||
| 79 | ;;;_* Dependency autoloads | 77 | ;;;_* Dependency loads |
| 80 | (require 'overlay) | 78 | (require 'overlay) |
| 81 | (eval-when-compile | 79 | (eval-when-compile |
| 82 | ;; Most of the requires here are for stuff covered by autoloads, which | 80 | ;; Most of the requires here are for stuff covered by autoloads, which |
| @@ -94,7 +92,9 @@ | |||
| 94 | 92 | ||
| 95 | ;;;_ > defgroup allout, allout-keybindings | 93 | ;;;_ > defgroup allout, allout-keybindings |
| 96 | (defgroup allout nil | 94 | (defgroup allout nil |
| 97 | "Extensive outline mode for use alone and with other modes." | 95 | "Extensive outline minor-mode, for use stand-alone and with other modes. |
| 96 | |||
| 97 | See Allout Auto Activation for automatic activation." | ||
| 98 | :prefix "allout-" | 98 | :prefix "allout-" |
| 99 | :group 'outlines) | 99 | :group 'outlines) |
| 100 | (defgroup allout-keybindings nil | 100 | (defgroup allout-keybindings nil |
| @@ -308,9 +308,7 @@ performing auto-layout is asked of the user each time. | |||
| 308 | With value \"activate\", only auto-mode-activation is enabled. | 308 | With value \"activate\", only auto-mode-activation is enabled. |
| 309 | Auto-layout is not. | 309 | Auto-layout is not. |
| 310 | 310 | ||
| 311 | With value nil, neither auto-mode-activation nor auto-layout are | 311 | With value nil, inhibit any automatic allout-mode activation." |
| 312 | enabled, and allout auto-activation processing is removed from | ||
| 313 | file visiting activities." | ||
| 314 | :set 'allout-auto-activation-helper | 312 | :set 'allout-auto-activation-helper |
| 315 | :type '(choice (const :tag "On" t) | 313 | :type '(choice (const :tag "On" t) |
| 316 | (const :tag "Ask about layout" "ask") | 314 | (const :tag "Ask about layout" "ask") |
| @@ -752,8 +750,10 @@ Set this var to the bullet you want to use for file cross-references." | |||
| 752 | ;;;###autoload | 750 | ;;;###autoload |
| 753 | (put 'allout-presentation-padding 'safe-local-variable 'integerp) | 751 | (put 'allout-presentation-padding 'safe-local-variable 'integerp) |
| 754 | 752 | ||
| 755 | ;;;_ = allout-abbreviate-flattened-numbering | 753 | ;;;_ = allout-flattened-numbering-abbreviation |
| 756 | (defcustom allout-abbreviate-flattened-numbering nil | 754 | (define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering |
| 755 | 'allout-flattened-numbering-abbreviation "24.0") | ||
| 756 | (defcustom allout-flattened-numbering-abbreviation nil | ||
| 757 | "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic | 757 | "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic |
| 758 | numbers to minimal amount with some context. Otherwise, entire | 758 | numbers to minimal amount with some context. Otherwise, entire |
| 759 | numbers are always used." | 759 | numbers are always used." |
| @@ -1553,6 +1553,7 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") | |||
| 1553 | ;;;_ > allout-mode-p () | 1553 | ;;;_ > allout-mode-p () |
| 1554 | ;; Must define this macro above any uses, or byte compilation will lack | 1554 | ;; Must define this macro above any uses, or byte compilation will lack |
| 1555 | ;; proper def, if file isn't loaded -- eg, during emacs build! | 1555 | ;; proper def, if file isn't loaded -- eg, during emacs build! |
| 1556 | ;;;###autoload | ||
| 1556 | (defmacro allout-mode-p () | 1557 | (defmacro allout-mode-p () |
| 1557 | "Return t if `allout-mode' is active in current buffer." | 1558 | "Return t if `allout-mode' is active in current buffer." |
| 1558 | 'allout-mode) | 1559 | 'allout-mode) |
| @@ -5410,7 +5411,7 @@ header and body. The elements of that list are: | |||
| 5410 | bullet))) | 5411 | bullet))) |
| 5411 | (cond ((listp format) | 5412 | (cond ((listp format) |
| 5412 | (list depth | 5413 | (list depth |
| 5413 | (if allout-abbreviate-flattened-numbering | 5414 | (if allout-flattened-numbering-abbreviation |
| 5414 | (allout-stringify-flat-index format | 5415 | (allout-stringify-flat-index format |
| 5415 | gone-out) | 5416 | gone-out) |
| 5416 | (allout-stringify-flat-index-plain | 5417 | (allout-stringify-flat-index-plain |
| @@ -6054,7 +6055,7 @@ signal." | |||
| 6054 | (with-temp-buffer | 6055 | (with-temp-buffer |
| 6055 | (insert text) | 6056 | (insert text) |
| 6056 | ;; convey the text characteristics of the original buffer: | 6057 | ;; convey the text characteristics of the original buffer: |
| 6057 | (allout-set-buffer-multibyte multibyte) | 6058 | (set-buffer-multibyte multibyte) |
| 6058 | (when encoding | 6059 | (when encoding |
| 6059 | (set-buffer-file-coding-system encoding) | 6060 | (set-buffer-file-coding-system encoding) |
| 6060 | (if (not decrypt) | 6061 | (if (not decrypt) |
| @@ -6085,9 +6086,14 @@ signal." | |||
| 6085 | 6086 | ||
| 6086 | (setq result-text | 6087 | (setq result-text |
| 6087 | (if decrypt | 6088 | (if decrypt |
| 6088 | (epg-decrypt-string epg-context | 6089 | (condition-case err |
| 6089 | (encode-coding-string massaged-text | 6090 | (epg-decrypt-string epg-context |
| 6090 | (or encoding 'utf-8))) | 6091 | (encode-coding-string massaged-text |
| 6092 | (or encoding 'utf-8))) | ||
| 6093 | (epg-error | ||
| 6094 | (signal 'egp-error | ||
| 6095 | (cons (concat (cadr err) " - gpg version problem?") | ||
| 6096 | (cddr err))))) | ||
| 6091 | (replace-regexp-in-string "\n$" "" | 6097 | (replace-regexp-in-string "\n$" "" |
| 6092 | (epg-encrypt-string epg-context | 6098 | (epg-encrypt-string epg-context |
| 6093 | (encode-coding-string massaged-text | 6099 | (encode-coding-string massaged-text |
| @@ -6673,14 +6679,6 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 6673 | 'previous-single-property-change) | 6679 | 'previous-single-property-change) |
| 6674 | ;; No docstring because xemacs defalias doesn't support it. | 6680 | ;; No docstring because xemacs defalias doesn't support it. |
| 6675 | ) | 6681 | ) |
| 6676 | ;;;_ > allout-set-buffer-multibyte | ||
| 6677 | (if (fboundp 'set-buffer-multibyte) | ||
| 6678 | (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) | ||
| 6679 | (with-no-warnings | ||
| 6680 | ;; this definition is used only in older or alternative emacs, where | ||
| 6681 | ;; the setting is our only recourse. | ||
| 6682 | (defun allout-set-buffer-multibyte (is-multibyte) | ||
| 6683 | (set enable-multibyte-characters is-multibyte)))) | ||
| 6684 | ;;;_ > allout-select-safe-coding-system | 6682 | ;;;_ > allout-select-safe-coding-system |
| 6685 | (defalias 'allout-select-safe-coding-system | 6683 | (defalias 'allout-select-safe-coding-system |
| 6686 | (if (fboundp 'select-safe-coding-system) | 6684 | (if (fboundp 'select-safe-coding-system) |
diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 95381ccdc0c..202b4e754d7 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el | |||
| @@ -32,7 +32,7 @@ | |||
| 32 | ;; | 32 | ;; |
| 33 | ;; (add-hook 'dired-load-hook | 33 | ;; (add-hook 'dired-load-hook |
| 34 | ;; (lambda () | 34 | ;; (lambda () |
| 35 | ;; (require 'dired-x) | 35 | ;; (load "dired-x") |
| 36 | ;; ;; Set global variables here. For example: | 36 | ;; ;; Set global variables here. For example: |
| 37 | ;; ;; (setq dired-guess-shell-gnutar "gtar") | 37 | ;; ;; (setq dired-guess-shell-gnutar "gtar") |
| 38 | ;; )) | 38 | ;; )) |
| @@ -79,7 +79,6 @@ | |||
| 79 | 79 | ||
| 80 | (defcustom dired-bind-vm nil | 80 | (defcustom dired-bind-vm nil |
| 81 | "Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'. | 81 | "Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'. |
| 82 | |||
| 83 | RMAIL files in the old Babyl format (used before before Emacs 23.1) | 82 | RMAIL files in the old Babyl format (used before before Emacs 23.1) |
| 84 | contain \"-*- rmail -*-\" at the top, so `dired-find-file' | 83 | contain \"-*- rmail -*-\" at the top, so `dired-find-file' |
| 85 | will run `rmail' on these files. New RMAIL files use the standard | 84 | will run `rmail' on these files. New RMAIL files use the standard |
| @@ -88,26 +87,49 @@ mbox format, and so cannot be distinguished in this way." | |||
| 88 | :group 'dired-keys) | 87 | :group 'dired-keys) |
| 89 | 88 | ||
| 90 | (defcustom dired-bind-jump t | 89 | (defcustom dired-bind-jump t |
| 91 | "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not." | 90 | "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not. |
| 91 | Setting this variable directly after dired-x is loaded has no effect - | ||
| 92 | use \\[customize]." | ||
| 92 | :type 'boolean | 93 | :type 'boolean |
| 94 | :set (lambda (sym val) | ||
| 95 | (if (set sym val) | ||
| 96 | (progn | ||
| 97 | (define-key global-map "\C-x\C-j" 'dired-jump) | ||
| 98 | (define-key global-map "\C-x4\C-j" 'dired-jump-other-window)) | ||
| 99 | (if (eq 'dired-jump (lookup-key global-map "\C-x\C-j")) | ||
| 100 | (define-key global-map "\C-x\C-j" nil)) | ||
| 101 | (if (eq 'dired-jump-other-window (lookup-key global-map "\C-x4\C-j")) | ||
| 102 | (define-key global-map "\C-x4\C-j" nil)))) | ||
| 93 | :group 'dired-keys) | 103 | :group 'dired-keys) |
| 94 | 104 | ||
| 95 | (defcustom dired-bind-man t | 105 | (defcustom dired-bind-man t |
| 96 | "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not." | 106 | "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not. |
| 107 | Setting this variable directly after dired-x is loaded has no effect - | ||
| 108 | use \\[customize]." | ||
| 97 | :type 'boolean | 109 | :type 'boolean |
| 110 | :set (lambda (sym val) | ||
| 111 | (if (set sym val) | ||
| 112 | (define-key dired-mode-map "N" 'dired-man) | ||
| 113 | (if (eq 'dired-man (lookup-key dired-mode-map "N")) | ||
| 114 | (define-key dired-mode-map "N" nil)))) | ||
| 98 | :group 'dired-keys) | 115 | :group 'dired-keys) |
| 99 | 116 | ||
| 100 | (defcustom dired-bind-info t | 117 | (defcustom dired-bind-info t |
| 101 | "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not." | 118 | "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not. |
| 119 | Setting this variable directly after dired-x is loaded has no effect - | ||
| 120 | use \\[customize]." | ||
| 102 | :type 'boolean | 121 | :type 'boolean |
| 122 | :set (lambda (sym val) | ||
| 123 | (if (set sym val) | ||
| 124 | (define-key dired-mode-map "I" 'dired-info) | ||
| 125 | (if (eq 'dired-info (lookup-key dired-mode-map "I")) | ||
| 126 | (define-key dired-mode-map "I" nil)))) | ||
| 103 | :group 'dired-keys) | 127 | :group 'dired-keys) |
| 104 | 128 | ||
| 105 | (defcustom dired-vm-read-only-folders nil | 129 | (defcustom dired-vm-read-only-folders nil |
| 106 | "If non-nil, \\[dired-vm] will visit all folders read-only. | 130 | "If non-nil, \\[dired-vm] will visit all folders read-only. |
| 107 | If neither nil nor t, e.g. the symbol `if-file-read-only', only | 131 | If neither nil nor t, e.g. the symbol `if-file-read-only', only |
| 108 | files not writable by you are visited read-only. | 132 | files not writable by you are visited read-only." |
| 109 | |||
| 110 | Read-only folders only work in VM 5, not in VM 4." | ||
| 111 | :type '(choice (const :tag "off" nil) | 133 | :type '(choice (const :tag "off" nil) |
| 112 | (const :tag "on" t) | 134 | (const :tag "on" t) |
| 113 | (other :tag "non-writable only" if-file-read-only)) | 135 | (other :tag "non-writable only" if-file-read-only)) |
| @@ -181,13 +203,20 @@ listing a directory. See also `dired-local-variables-file'." | |||
| 181 | :type 'boolean | 203 | :type 'boolean |
| 182 | :group 'dired-x) | 204 | :group 'dired-x) |
| 183 | 205 | ||
| 184 | (defcustom dired-guess-shell-gnutar (when (or (eq system-type 'gnu) | 206 | (defcustom dired-guess-shell-gnutar |
| 185 | (eq system-type 'gnu/linux)) | 207 | (catch 'found |
| 186 | "tar") | 208 | (dolist (exe '("tar" "gtar")) |
| 209 | (if (with-temp-buffer | ||
| 210 | (ignore-errors (call-process exe nil t nil "--version")) | ||
| 211 | (and (re-search-backward "GNU tar" nil t) t)) | ||
| 212 | (throw 'found exe)))) | ||
| 187 | "If non-nil, name of GNU tar executable. | 213 | "If non-nil, name of GNU tar executable. |
| 188 | \(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for | 214 | \(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for |
| 189 | compressed or gzip'ed tar files. If you don't have GNU tar, set this | 215 | compressed or gzip'ed tar files. If you don't have GNU tar, set this |
| 190 | to nil: a pipe using `zcat' or `gunzip -c' will be used." | 216 | to nil: a pipe using `zcat' or `gunzip -c' will be used." |
| 217 | ;; Changed from system-type test to testing --version output. | ||
| 218 | ;; Maybe test --help for -z instead? | ||
| 219 | :version "24.1" | ||
| 191 | :type '(choice (const :tag "Not GNU tar" nil) | 220 | :type '(choice (const :tag "Not GNU tar" nil) |
| 192 | (string :tag "Command name")) | 221 | (string :tag "Command name")) |
| 193 | :group 'dired-x) | 222 | :group 'dired-x) |
| @@ -216,19 +245,12 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." | |||
| 216 | (define-key dired-mode-map "*(" 'dired-mark-sexp) | 245 | (define-key dired-mode-map "*(" 'dired-mark-sexp) |
| 217 | (define-key dired-mode-map "*." 'dired-mark-extension) | 246 | (define-key dired-mode-map "*." 'dired-mark-extension) |
| 218 | (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) | 247 | (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) |
| 219 | (define-key dired-mode-map "w" 'dired-copy-filename-as-kill) | ||
| 220 | (define-key dired-mode-map "\M-G" 'dired-goto-subdir) | 248 | (define-key dired-mode-map "\M-G" 'dired-goto-subdir) |
| 221 | (define-key dired-mode-map "F" 'dired-do-find-marked-files) | 249 | (define-key dired-mode-map "F" 'dired-do-find-marked-files) |
| 222 | (define-key dired-mode-map "Y" 'dired-do-relsymlink) | 250 | (define-key dired-mode-map "Y" 'dired-do-relsymlink) |
| 223 | (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp) | 251 | (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp) |
| 224 | (define-key dired-mode-map "V" 'dired-do-run-mail) | 252 | (define-key dired-mode-map "V" 'dired-do-run-mail) |
| 225 | 253 | ||
| 226 | (if dired-bind-man | ||
| 227 | (define-key dired-mode-map "N" 'dired-man)) | ||
| 228 | |||
| 229 | (if dired-bind-info | ||
| 230 | (define-key dired-mode-map "I" 'dired-info)) | ||
| 231 | |||
| 232 | ;;; MENU BINDINGS | 254 | ;;; MENU BINDINGS |
| 233 | 255 | ||
| 234 | (require 'easymenu) | 256 | (require 'easymenu) |
| @@ -270,11 +292,6 @@ matching regexp"] | |||
| 270 | files"] | 292 | files"] |
| 271 | "Refresh")) | 293 | "Refresh")) |
| 272 | 294 | ||
| 273 | ;;; GLOBAL BINDING. | ||
| 274 | (when dired-bind-jump | ||
| 275 | (define-key global-map "\C-x\C-j" 'dired-jump) | ||
| 276 | (define-key global-map "\C-x4\C-j" 'dired-jump-other-window)) | ||
| 277 | |||
| 278 | 295 | ||
| 279 | ;; Install into appropriate hooks. | 296 | ;; Install into appropriate hooks. |
| 280 | 297 | ||
| @@ -290,31 +307,9 @@ files"] | |||
| 290 | \\[dired-do-find-marked-files]\t-- visit all marked files simultaneously | 307 | \\[dired-do-find-marked-files]\t-- visit all marked files simultaneously |
| 291 | \\[dired-omit-mode]\t-- toggle omitting of files | 308 | \\[dired-omit-mode]\t-- toggle omitting of files |
| 292 | \\[dired-mark-sexp]\t-- mark by Lisp expression | 309 | \\[dired-mark-sexp]\t-- mark by Lisp expression |
| 293 | \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring; | ||
| 294 | \t you can feed it to other commands using \\[yank] | ||
| 295 | |||
| 296 | For more features, see variables | ||
| 297 | |||
| 298 | `dired-bind-vm' | ||
| 299 | `dired-bind-jump' | ||
| 300 | `dired-bind-info' | ||
| 301 | `dired-bind-man' | ||
| 302 | `dired-vm-read-only-folders' | ||
| 303 | `dired-omit-mode' | ||
| 304 | `dired-omit-files' | ||
| 305 | `dired-omit-extensions' | ||
| 306 | `dired-omit-size-limit' | ||
| 307 | `dired-find-subdir' | ||
| 308 | `dired-enable-local-variables' | ||
| 309 | `dired-local-variables-file' | ||
| 310 | `dired-guess-shell-gnutar' | ||
| 311 | `dired-guess-shell-gzip-quiet' | ||
| 312 | `dired-guess-shell-znew-switches' | ||
| 313 | `dired-guess-shell-alist-user' | ||
| 314 | `dired-clean-up-buffers-too' | ||
| 315 | |||
| 316 | See also functions | ||
| 317 | 310 | ||
| 311 | To see the options you can set, use M-x customize-group RET dired-x RET. | ||
| 312 | See also the functions: | ||
| 318 | `dired-flag-extension' | 313 | `dired-flag-extension' |
| 319 | `dired-virtual' | 314 | `dired-virtual' |
| 320 | `dired-jump' | 315 | `dired-jump' |
| @@ -324,7 +319,6 @@ See also functions | |||
| 324 | `dired-info' | 319 | `dired-info' |
| 325 | `dired-do-find-marked-files'" | 320 | `dired-do-find-marked-files'" |
| 326 | (interactive) | 321 | (interactive) |
| 327 | |||
| 328 | ;; These must be done in each new dired buffer. | 322 | ;; These must be done in each new dired buffer. |
| 329 | (dired-hack-local-variables) | 323 | (dired-hack-local-variables) |
| 330 | (dired-omit-startup)) | 324 | (dired-omit-startup)) |
| @@ -339,28 +333,21 @@ Remove expanded subdir of deleted dir, if any." | |||
| 339 | (save-excursion (and (cdr dired-subdir-alist) | 333 | (save-excursion (and (cdr dired-subdir-alist) |
| 340 | (dired-goto-subdir fn) | 334 | (dired-goto-subdir fn) |
| 341 | (dired-kill-subdir))) | 335 | (dired-kill-subdir))) |
| 342 | |||
| 343 | ;; Offer to kill buffer of deleted file FN. | 336 | ;; Offer to kill buffer of deleted file FN. |
| 344 | (if dired-clean-up-buffers-too | 337 | (when dired-clean-up-buffers-too |
| 345 | (progn | 338 | (let ((buf (get-file-buffer fn))) |
| 346 | (let ((buf (get-file-buffer fn))) | 339 | (and buf |
| 347 | (and buf | 340 | (funcall (function y-or-n-p) |
| 348 | (funcall (function y-or-n-p) | 341 | (format "Kill buffer of %s, too? " |
| 349 | (format "Kill buffer of %s, too? " | 342 | (file-name-nondirectory fn))) |
| 350 | (file-name-nondirectory fn))) | 343 | (kill-buffer buf))) |
| 351 | (save-excursion ; you never know where kill-buffer leaves you | 344 | (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) |
| 352 | (kill-buffer buf)))) | 345 | (and buf-list |
| 353 | (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))) | 346 | (y-or-n-p (format "Kill dired buffer%s of %s, too? " |
| 354 | (buf nil)) | 347 | (dired-plural-s (length buf-list)) |
| 355 | (and buf-list | 348 | (file-name-nondirectory fn))) |
| 356 | (y-or-n-p (format "Kill dired buffer%s of %s, too? " | 349 | (dolist (buf buf-list) |
| 357 | (dired-plural-s (length buf-list)) | 350 | (kill-buffer buf)))))) |
| 358 | (file-name-nondirectory fn))) | ||
| 359 | (while buf-list | ||
| 360 | (save-excursion (kill-buffer (car buf-list))) | ||
| 361 | (setq buf-list (cdr buf-list))))))) | ||
| 362 | ;; Anything else? | ||
| 363 | ) | ||
| 364 | 351 | ||
| 365 | 352 | ||
| 366 | ;;; EXTENSION MARKING FUNCTIONS. | 353 | ;;; EXTENSION MARKING FUNCTIONS. |
| @@ -460,11 +447,10 @@ move to its line in dired." | |||
| 460 | (progn | 447 | (progn |
| 461 | (setq dir (dired-current-directory)) | 448 | (setq dir (dired-current-directory)) |
| 462 | (dired-up-directory other-window) | 449 | (dired-up-directory other-window) |
| 463 | (or (dired-goto-file dir) | 450 | (unless (dired-goto-file dir) |
| 464 | ;; refresh and try again | 451 | ;; refresh and try again |
| 465 | (progn | 452 | (dired-insert-subdir (file-name-directory dir)) |
| 466 | (dired-insert-subdir (file-name-directory dir)) | 453 | (dired-goto-file dir))) |
| 467 | (dired-goto-file dir)))) | ||
| 468 | (if other-window | 454 | (if other-window |
| 469 | (dired-other-window dir) | 455 | (dired-other-window dir) |
| 470 | (dired dir)) | 456 | (dired dir)) |
| @@ -475,10 +461,9 @@ move to its line in dired." | |||
| 475 | (dired-insert-subdir (file-name-directory file)) | 461 | (dired-insert-subdir (file-name-directory file)) |
| 476 | (dired-goto-file file)) | 462 | (dired-goto-file file)) |
| 477 | ;; Toggle omitting, if it is on, and try again. | 463 | ;; Toggle omitting, if it is on, and try again. |
| 478 | (if dired-omit-mode | 464 | (when dired-omit-mode |
| 479 | (progn | 465 | (dired-omit-mode) |
| 480 | (dired-omit-mode) | 466 | (dired-goto-file file))))))) |
| 481 | (dired-goto-file file)))))))) | ||
| 482 | 467 | ||
| 483 | (defun dired-jump-other-window (&optional file-name) | 468 | (defun dired-jump-other-window (&optional file-name) |
| 484 | "Like \\[dired-jump] (`dired-jump') but in other window." | 469 | "Like \\[dired-jump] (`dired-jump') but in other window." |
| @@ -695,7 +680,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." | |||
| 695 | (forward-line 1) | 680 | (forward-line 1) |
| 696 | (and (looking-at "^ wildcard ") | 681 | (and (looking-at "^ wildcard ") |
| 697 | (buffer-substring (match-end 0) | 682 | (buffer-substring (match-end 0) |
| 698 | (progn (end-of-line) (point))))))) | 683 | (line-end-position)))))) |
| 699 | (if wildcard | 684 | (if wildcard |
| 700 | (setq dirname (expand-file-name wildcard default-directory)))) | 685 | (setq dirname (expand-file-name wildcard default-directory)))) |
| 701 | ;; If raw ls listing (not a saved old dired buffer), give it a | 686 | ;; If raw ls listing (not a saved old dired buffer), give it a |
| @@ -777,9 +762,12 @@ Also useful for `auto-mode-alist' like this: | |||
| 777 | ;; mechanism is provided for special handling of the working directory in | 762 | ;; mechanism is provided for special handling of the working directory in |
| 778 | ;; special major modes. | 763 | ;; special major modes. |
| 779 | 764 | ||
| 765 | (define-obsolete-variable-alias 'default-directory-alist | ||
| 766 | 'dired-default-directory-alist "24.1") | ||
| 767 | |||
| 780 | ;; It's easier to add to this alist than redefine function | 768 | ;; It's easier to add to this alist than redefine function |
| 781 | ;; default-directory while keeping the old information. | 769 | ;; default-directory while keeping the old information. |
| 782 | (defconst default-directory-alist | 770 | (defconst dired-default-directory-alist |
| 783 | '((dired-mode . (if (fboundp 'dired-current-directory) | 771 | '((dired-mode . (if (fboundp 'dired-current-directory) |
| 784 | (dired-current-directory) | 772 | (dired-current-directory) |
| 785 | default-directory))) | 773 | default-directory))) |
| @@ -789,8 +777,8 @@ nil is ignored in favor of `default-directory'.") | |||
| 789 | 777 | ||
| 790 | (defun dired-default-directory () | 778 | (defun dired-default-directory () |
| 791 | "Usage like variable `default-directory'. | 779 | "Usage like variable `default-directory'. |
| 792 | Knows about the special cases in variable `default-directory-alist'." | 780 | Knows about the special cases in variable `dired-default-directory-alist'." |
| 793 | (or (eval (cdr (assq major-mode default-directory-alist))) | 781 | (or (eval (cdr (assq major-mode dired-default-directory-alist))) |
| 794 | default-directory)) | 782 | default-directory)) |
| 795 | 783 | ||
| 796 | (defun dired-smart-shell-command (command &optional output-buffer error-buffer) | 784 | (defun dired-smart-shell-command (command &optional output-buffer error-buffer) |
| @@ -1369,8 +1357,9 @@ NOSELECT the files are merely found but not selected." | |||
| 1369 | (declare-function Man-getpage-in-background "man" (topic)) | 1357 | (declare-function Man-getpage-in-background "man" (topic)) |
| 1370 | 1358 | ||
| 1371 | (defun dired-man () | 1359 | (defun dired-man () |
| 1372 | "Run man on this file. Display old buffer if buffer name matches filename. | 1360 | "Run `man' on this file." |
| 1373 | Uses `man.el' of \\[manual-entry] fame." | 1361 | ;; Used also to say: "Display old buffer if buffer name matches filename." |
| 1362 | ;; but I have no idea what that means. | ||
| 1374 | (interactive) | 1363 | (interactive) |
| 1375 | (require 'man) | 1364 | (require 'man) |
| 1376 | (let* ((file (dired-get-filename)) | 1365 | (let* ((file (dired-get-filename)) |
| @@ -1382,7 +1371,7 @@ Uses `man.el' of \\[manual-entry] fame." | |||
| 1382 | ;; Run Info on files. | 1371 | ;; Run Info on files. |
| 1383 | 1372 | ||
| 1384 | (defun dired-info () | 1373 | (defun dired-info () |
| 1385 | "Run info on this file." | 1374 | "Run `info' on this file." |
| 1386 | (interactive) | 1375 | (interactive) |
| 1387 | (info (dired-get-filename))) | 1376 | (info (dired-get-filename))) |
| 1388 | 1377 | ||
| @@ -1393,17 +1382,16 @@ Uses `man.el' of \\[manual-entry] fame." | |||
| 1393 | 1382 | ||
| 1394 | (defun dired-vm (&optional read-only) | 1383 | (defun dired-vm (&optional read-only) |
| 1395 | "Run VM on this file. | 1384 | "Run VM on this file. |
| 1396 | With prefix arg, visit folder read-only (this requires at least VM 5). | 1385 | With optional prefix argument, visits the folder read-only. |
| 1397 | See also variable `dired-vm-read-only-folders'." | 1386 | Otherwise obeys the value of `dired-vm-read-only-folders'." |
| 1398 | (interactive "P") | 1387 | (interactive "P") |
| 1399 | (let ((dir (dired-current-directory)) | 1388 | (let ((dir (dired-current-directory)) |
| 1400 | (fil (dired-get-filename))) | 1389 | (fil (dired-get-filename))) |
| 1401 | ;; take care to supply 2nd arg only if requested - may still run VM 4! | 1390 | (vm-visit-folder fil (or read-only |
| 1402 | (cond (read-only (vm-visit-folder fil t)) | 1391 | (eq t dired-vm-read-only-folders) |
| 1403 | ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t)) | 1392 | (and dired-vm-read-only-folders |
| 1404 | ((null dired-vm-read-only-folders) (vm-visit-folder fil)) | 1393 | (not (file-writable-p fil))))) |
| 1405 | (t (vm-visit-folder fil (not (file-writable-p fil))))) | 1394 | ;; So that pressing `v' inside VM does prompt within current directory: |
| 1406 | ;; so that pressing `v' inside VM does prompt within current directory: | ||
| 1407 | (set (make-local-variable 'vm-folder-directory) dir))) | 1395 | (set (make-local-variable 'vm-folder-directory) dir))) |
| 1408 | 1396 | ||
| 1409 | (defun dired-rmail () | 1397 | (defun dired-rmail () |
| @@ -1412,7 +1400,7 @@ See also variable `dired-vm-read-only-folders'." | |||
| 1412 | (rmail (dired-get-filename))) | 1400 | (rmail (dired-get-filename))) |
| 1413 | 1401 | ||
| 1414 | (defun dired-do-run-mail () | 1402 | (defun dired-do-run-mail () |
| 1415 | "If `dired-bind-vm' is t, then function `dired-vm', otherwise `dired-rmail'." | 1403 | "If `dired-bind-vm' is non-nil, call `dired-vm', else call `dired-rmail'." |
| 1416 | (interactive) | 1404 | (interactive) |
| 1417 | (if dired-bind-vm | 1405 | (if dired-bind-vm |
| 1418 | ;; Read mail folder using vm. | 1406 | ;; Read mail folder using vm. |
| @@ -1450,16 +1438,11 @@ See also variable `dired-vm-read-only-folders'." | |||
| 1450 | 1438 | ||
| 1451 | ;; This should be a builtin | 1439 | ;; This should be a builtin |
| 1452 | (defun dired-buffer-more-recently-used-p (buffer1 buffer2) | 1440 | (defun dired-buffer-more-recently-used-p (buffer1 buffer2) |
| 1453 | "Return t if BUFFER1 is more recently used than BUFFER2." | 1441 | "Return t if BUFFER1 is more recently used than BUFFER2. |
| 1454 | (if (equal buffer1 buffer2) | 1442 | Considers buffers closer to the car of `buffer-list' to be more recent." |
| 1455 | nil | 1443 | (and (not (equal buffer1 buffer2)) |
| 1456 | (let ((more-recent nil) | 1444 | (memq buffer1 (buffer-list)) |
| 1457 | (list (buffer-list))) | 1445 | (not (memq buffer1 (memq buffer2 (buffer-list)))))) |
| 1458 | (while (and list | ||
| 1459 | (not (setq more-recent (equal buffer1 (car list)))) | ||
| 1460 | (not (equal buffer2 (car list)))) | ||
| 1461 | (setq list (cdr list))) | ||
| 1462 | more-recent))) | ||
| 1463 | 1446 | ||
| 1464 | ;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 | 1447 | ;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 |
| 1465 | ;; (defun dired-buffers-for-dir-exact (dir) | 1448 | ;; (defun dired-buffers-for-dir-exact (dir) |
| @@ -1559,7 +1542,7 @@ to mark all zero length files." | |||
| 1559 | (forward-char mode-len) | 1542 | (forward-char mode-len) |
| 1560 | (setq nlink (read (current-buffer))) | 1543 | (setq nlink (read (current-buffer))) |
| 1561 | ;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid. | 1544 | ;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid. |
| 1562 | (setq uid (buffer-substring (+ (point) 1) | 1545 | (setq uid (buffer-substring (1+ (point)) |
| 1563 | (progn (forward-word 1) (point)))) | 1546 | (progn (forward-word 1) (point)))) |
| 1564 | (re-search-forward directory-listing-before-filename-regexp) | 1547 | (re-search-forward directory-listing-before-filename-regexp) |
| 1565 | (goto-char (match-beginning 1)) | 1548 | (goto-char (match-beginning 1)) |
| @@ -1649,7 +1632,7 @@ Identical to `find-file' except when called interactively, with a prefix arg | |||
| 1649 | \(e.g., \\[universal-argument]\), in which case it guesses filename near point. | 1632 | \(e.g., \\[universal-argument]\), in which case it guesses filename near point. |
| 1650 | Useful for editing file mentioned in buffer you are viewing, | 1633 | Useful for editing file mentioned in buffer you are viewing, |
| 1651 | or to test if that file exists. Use minibuffer after snatching filename." | 1634 | or to test if that file exists. Use minibuffer after snatching filename." |
| 1652 | (interactive (list (read-filename-at-point "Find file: "))) | 1635 | (interactive (list (dired-x-read-filename-at-point "Find file: "))) |
| 1653 | (find-file (expand-file-name filename))) | 1636 | (find-file (expand-file-name filename))) |
| 1654 | 1637 | ||
| 1655 | (defun dired-x-find-file-other-window (filename) | 1638 | (defun dired-x-find-file-other-window (filename) |
| @@ -1661,52 +1644,43 @@ Identical to `find-file-other-window' except when called interactively, with | |||
| 1661 | a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. | 1644 | a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. |
| 1662 | Useful for editing file mentioned in buffer you are viewing, | 1645 | Useful for editing file mentioned in buffer you are viewing, |
| 1663 | or to test if that file exists. Use minibuffer after snatching filename." | 1646 | or to test if that file exists. Use minibuffer after snatching filename." |
| 1664 | (interactive (list (read-filename-at-point "Find file: "))) | 1647 | (interactive (list (dired-x-read-filename-at-point "Find file: "))) |
| 1665 | (find-file-other-window (expand-file-name filename))) | 1648 | (find-file-other-window (expand-file-name filename))) |
| 1666 | 1649 | ||
| 1667 | ;;; Internal functions. | 1650 | ;;; Internal functions. |
| 1668 | 1651 | ||
| 1669 | ;; Fixme: This should probably use `thing-at-point'. -- fx | 1652 | ;; Fixme: This should probably use `thing-at-point'. -- fx |
| 1670 | (defun dired-filename-at-point () | 1653 | (defun dired-filename-at-point () |
| 1671 | "Get the filename closest to point, but do not change position. | 1654 | "Return the filename closest to point, expanded. |
| 1672 | Has a preference for looking backward when not directly on a symbol. | 1655 | Point should be in or after a filename." |
| 1673 | Not perfect - point must be in middle of or end of filename." | ||
| 1674 | |||
| 1675 | (let ((filename-chars "-.[:alnum:]_/:$+@") | 1656 | (let ((filename-chars "-.[:alnum:]_/:$+@") |
| 1676 | start end filename prefix) | 1657 | start end filename prefix) |
| 1677 | |||
| 1678 | (save-excursion | 1658 | (save-excursion |
| 1679 | ;; First see if just past a filename. | 1659 | ;; First see if just past a filename. |
| 1680 | (if (not (eobp)) | 1660 | (or (eobp) ; why? |
| 1681 | (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens | 1661 | (when (looking-at "[] \t\n[{}()]") ; whitespace or some parens |
| 1682 | (progn | 1662 | (skip-chars-backward " \n\t\r({[]})") |
| 1683 | (skip-chars-backward " \n\t\r({[]})") | 1663 | (or (bobp) (backward-char 1)))) |
| 1684 | (if (not (bobp)) | 1664 | (if (looking-at (format "[%s]" filename-chars)) |
| 1685 | (backward-char 1))))) | ||
| 1686 | |||
| 1687 | (if (string-match (concat "[" filename-chars "]") | ||
| 1688 | (char-to-string (following-char))) | ||
| 1689 | (progn | 1665 | (progn |
| 1690 | (if (re-search-backward (concat "[^" filename-chars "]") nil t) | 1666 | (skip-chars-backward filename-chars) |
| 1691 | (forward-char) | 1667 | (setq start (point) |
| 1692 | (goto-char (point-min))) | 1668 | prefix |
| 1693 | (setq start (point)) | 1669 | ;; This is something to do with ange-ftp filenames. |
| 1694 | (setq prefix | 1670 | ;; It convert foo@bar to /foo@bar. |
| 1671 | ;; But when does the former occur in dired buffers? | ||
| 1695 | (and (string-match | 1672 | (and (string-match |
| 1696 | "^\\w+@" | 1673 | "^\\w+@" |
| 1697 | (buffer-substring start (line-beginning-position))) | 1674 | (buffer-substring start (line-end-position))) |
| 1698 | "/")) | 1675 | "/")) |
| 1699 | (goto-char start) | ||
| 1700 | (if (string-match "[/~]" (char-to-string (preceding-char))) | 1676 | (if (string-match "[/~]" (char-to-string (preceding-char))) |
| 1701 | (setq start (1- start))) | 1677 | (setq start (1- start))) |
| 1702 | (re-search-forward (concat "\\=[" filename-chars "]*") nil t)) | 1678 | (skip-chars-forward filename-chars)) |
| 1703 | |||
| 1704 | (error "No file found around point!")) | 1679 | (error "No file found around point!")) |
| 1705 | |||
| 1706 | ;; Return string. | 1680 | ;; Return string. |
| 1707 | (expand-file-name (concat prefix (buffer-substring start (point))))))) | 1681 | (expand-file-name (concat prefix (buffer-substring start (point))))))) |
| 1708 | 1682 | ||
| 1709 | (defun read-filename-at-point (prompt) | 1683 | (defun dired-x-read-filename-at-point (prompt) |
| 1710 | "Return filename prompting with PROMPT with completion. | 1684 | "Return filename prompting with PROMPT with completion. |
| 1711 | If `current-prefix-arg' is non-nil, uses name at point as guess." | 1685 | If `current-prefix-arg' is non-nil, uses name at point as guess." |
| 1712 | (if current-prefix-arg | 1686 | (if current-prefix-arg |
| @@ -1716,6 +1690,9 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." | |||
| 1716 | guess | 1690 | guess |
| 1717 | nil (file-name-nondirectory guess))) | 1691 | nil (file-name-nondirectory guess))) |
| 1718 | (read-file-name prompt default-directory))) | 1692 | (read-file-name prompt default-directory))) |
| 1693 | |||
| 1694 | (define-obsolete-function-alias 'read-filename-at-point | ||
| 1695 | 'dired-x-read-filename-at-point "24.1") ; is this even needed? | ||
| 1719 | 1696 | ||
| 1720 | ;;; BUG REPORTS | 1697 | ;;; BUG REPORTS |
| 1721 | 1698 | ||
diff --git a/lisp/dired.el b/lisp/dired.el index 058dbdc548a..22d9f91648c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -4029,7 +4029,7 @@ true then the type of the file linked to by FILE is printed instead. | |||
| 4029 | ;;;*** | 4029 | ;;;*** |
| 4030 | 4030 | ||
| 4031 | ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" | 4031 | ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" |
| 4032 | ;;;;;; "d35468f85920d324895b0c04bb703328") | 4032 | ;;;;;; "a2af6147cf06b53166d9e1a3bb200675") |
| 4033 | ;;; Generated autoloads from dired-x.el | 4033 | ;;; Generated autoloads from dired-x.el |
| 4034 | 4034 | ||
| 4035 | (autoload 'dired-jump "dired-x" "\ | 4035 | (autoload 'dired-jump "dired-x" "\ |
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 695dc1e2db6..b3c95fcc78f 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el | |||
| @@ -1877,6 +1877,7 @@ BUFFER-NAME, if non-nil, is the buffer name to use." | |||
| 1877 | (let ((inhibit-read-only t)) | 1877 | (let ((inhibit-read-only t)) |
| 1878 | (buffer-disable-undo) | 1878 | (buffer-disable-undo) |
| 1879 | (erase-buffer) | 1879 | (erase-buffer) |
| 1880 | (ert-results-mode) | ||
| 1880 | ;; Erase buffer again in case switching out of the previous | 1881 | ;; Erase buffer again in case switching out of the previous |
| 1881 | ;; mode inserted anything. (This happens e.g. when switching | 1882 | ;; mode inserted anything. (This happens e.g. when switching |
| 1882 | ;; from ert-results-mode to ert-results-mode when | 1883 | ;; from ert-results-mode to ert-results-mode when |
| @@ -1895,9 +1896,8 @@ BUFFER-NAME, if non-nil, is the buffer name to use." | |||
| 1895 | (ewoc-enter-last ewoc | 1896 | (ewoc-enter-last ewoc |
| 1896 | (make-ert--ewoc-entry :test test :hidden-p t))) | 1897 | (make-ert--ewoc-entry :test test :hidden-p t))) |
| 1897 | (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) | 1898 | (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) |
| 1898 | (goto-char (1- (point-max))))) | 1899 | (goto-char (1- (point-max))) |
| 1899 | (ert-results-mode) | 1900 | buffer))))) |
| 1900 | buffer))) | ||
| 1901 | 1901 | ||
| 1902 | 1902 | ||
| 1903 | (defvar ert--selector-history nil | 1903 | (defvar ert--selector-history nil |
| @@ -2343,6 +2343,7 @@ To be used in the ERT results buffer." | |||
| 2343 | (let ((inhibit-read-only t)) | 2343 | (let ((inhibit-read-only t)) |
| 2344 | (buffer-disable-undo) | 2344 | (buffer-disable-undo) |
| 2345 | (erase-buffer) | 2345 | (erase-buffer) |
| 2346 | (ert-simple-view-mode) | ||
| 2346 | ;; Use unibyte because `debugger-setup-buffer' also does so. | 2347 | ;; Use unibyte because `debugger-setup-buffer' also does so. |
| 2347 | (set-buffer-multibyte nil) | 2348 | (set-buffer-multibyte nil) |
| 2348 | (setq truncate-lines t) | 2349 | (setq truncate-lines t) |
| @@ -2351,8 +2352,7 @@ To be used in the ERT results buffer." | |||
| 2351 | (goto-char (point-min)) | 2352 | (goto-char (point-min)) |
| 2352 | (insert "Backtrace for test `") | 2353 | (insert "Backtrace for test `") |
| 2353 | (ert-insert-test-name-button (ert-test-name test)) | 2354 | (ert-insert-test-name-button (ert-test-name test)) |
| 2354 | (insert "':\n") | 2355 | (insert "':\n"))))))) |
| 2355 | (ert-simple-view-mode))))))) | ||
| 2356 | 2356 | ||
| 2357 | (defun ert-results-pop-to-messages-for-test-at-point () | 2357 | (defun ert-results-pop-to-messages-for-test-at-point () |
| 2358 | "Display the part of the *Messages* buffer generated during the test at point. | 2358 | "Display the part of the *Messages* buffer generated during the test at point. |
| @@ -2368,12 +2368,12 @@ To be used in the ERT results buffer." | |||
| 2368 | (let ((inhibit-read-only t)) | 2368 | (let ((inhibit-read-only t)) |
| 2369 | (buffer-disable-undo) | 2369 | (buffer-disable-undo) |
| 2370 | (erase-buffer) | 2370 | (erase-buffer) |
| 2371 | (ert-simple-view-mode) | ||
| 2371 | (insert (ert-test-result-messages result)) | 2372 | (insert (ert-test-result-messages result)) |
| 2372 | (goto-char (point-min)) | 2373 | (goto-char (point-min)) |
| 2373 | (insert "Messages for test `") | 2374 | (insert "Messages for test `") |
| 2374 | (ert-insert-test-name-button (ert-test-name test)) | 2375 | (ert-insert-test-name-button (ert-test-name test)) |
| 2375 | (insert "':\n") | 2376 | (insert "':\n"))))) |
| 2376 | (ert-simple-view-mode))))) | ||
| 2377 | 2377 | ||
| 2378 | (defun ert-results-pop-to-should-forms-for-test-at-point () | 2378 | (defun ert-results-pop-to-should-forms-for-test-at-point () |
| 2379 | "Display the list of `should' forms executed during the test at point. | 2379 | "Display the list of `should' forms executed during the test at point. |
| @@ -2389,6 +2389,7 @@ To be used in the ERT results buffer." | |||
| 2389 | (let ((inhibit-read-only t)) | 2389 | (let ((inhibit-read-only t)) |
| 2390 | (buffer-disable-undo) | 2390 | (buffer-disable-undo) |
| 2391 | (erase-buffer) | 2391 | (erase-buffer) |
| 2392 | (ert-simple-view-mode) | ||
| 2392 | (if (null (ert-test-result-should-forms result)) | 2393 | (if (null (ert-test-result-should-forms result)) |
| 2393 | (insert "\n(No should forms during this test.)\n") | 2394 | (insert "\n(No should forms during this test.)\n") |
| 2394 | (loop for form-description in (ert-test-result-should-forms result) | 2395 | (loop for form-description in (ert-test-result-should-forms result) |
| @@ -2406,8 +2407,7 @@ To be used in the ERT results buffer." | |||
| 2406 | (insert (concat "(Values are shallow copies and may have " | 2407 | (insert (concat "(Values are shallow copies and may have " |
| 2407 | "looked different during the test if they\n" | 2408 | "looked different during the test if they\n" |
| 2408 | "have been modified destructively.)\n")) | 2409 | "have been modified destructively.)\n")) |
| 2409 | (forward-line 1) | 2410 | (forward-line 1))))) |
| 2410 | (ert-simple-view-mode))))) | ||
| 2411 | 2411 | ||
| 2412 | (defun ert-results-toggle-printer-limits-for-test-at-point () | 2412 | (defun ert-results-toggle-printer-limits-for-test-at-point () |
| 2413 | "Toggle how much of the condition to print for the test at point. | 2413 | "Toggle how much of the condition to print for the test at point. |
| @@ -2442,6 +2442,7 @@ To be used in the ERT results buffer." | |||
| 2442 | (let ((inhibit-read-only t)) | 2442 | (let ((inhibit-read-only t)) |
| 2443 | (buffer-disable-undo) | 2443 | (buffer-disable-undo) |
| 2444 | (erase-buffer) | 2444 | (erase-buffer) |
| 2445 | (ert-simple-view-mode) | ||
| 2445 | (if (null data) | 2446 | (if (null data) |
| 2446 | (insert "(No data)\n") | 2447 | (insert "(No data)\n") |
| 2447 | (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) | 2448 | (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) |
| @@ -2454,8 +2455,7 @@ To be used in the ERT results buffer." | |||
| 2454 | (insert "\n")))) | 2455 | (insert "\n")))) |
| 2455 | (goto-char (point-min)) | 2456 | (goto-char (point-min)) |
| 2456 | (insert "Tests by run time (seconds):\n\n") | 2457 | (insert "Tests by run time (seconds):\n\n") |
| 2457 | (forward-line 1) | 2458 | (forward-line 1)))) |
| 2458 | (ert-simple-view-mode)))) | ||
| 2459 | 2459 | ||
| 2460 | ;;;###autoload | 2460 | ;;;###autoload |
| 2461 | (defun ert-describe-test (test-or-test-name) | 2461 | (defun ert-describe-test (test-or-test-name) |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 24ea0a3e801..3179672a3ec 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -61,6 +61,8 @@ UPatterns can take the following forms: | |||
| 61 | `QPAT matches if the QPattern QPAT matches. | 61 | `QPAT matches if the QPattern QPAT matches. |
| 62 | (pred PRED) matches if PRED applied to the object returns non-nil. | 62 | (pred PRED) matches if PRED applied to the object returns non-nil. |
| 63 | (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. | 63 | (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. |
| 64 | If a SYMBOL is used twice in the same pattern (i.e. the pattern is | ||
| 65 | \"non-linear\"), then the second occurrence is turned into an `eq'uality test. | ||
| 64 | 66 | ||
| 65 | QPatterns can take the following forms: | 67 | QPatterns can take the following forms: |
| 66 | (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. | 68 | (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. |
| @@ -457,7 +459,12 @@ and otherwise defers to REST which is a list of branches of the form | |||
| 457 | (pcase--u1 matches code vars then-rest) | 459 | (pcase--u1 matches code vars then-rest) |
| 458 | (pcase--u else-rest)))) | 460 | (pcase--u else-rest)))) |
| 459 | ((symbolp upat) | 461 | ((symbolp upat) |
| 460 | (pcase--u1 matches code (cons (cons upat sym) vars) rest)) | 462 | (if (not (assq upat vars)) |
| 463 | (pcase--u1 matches code (cons (cons upat sym) vars) rest) | ||
| 464 | ;; Non-linear pattern. Turn it into an `eq' test. | ||
| 465 | (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars))))) | ||
| 466 | matches) | ||
| 467 | code vars rest))) | ||
| 461 | ((eq (car-safe upat) '\`) | 468 | ((eq (car-safe upat) '\`) |
| 462 | (pcase--q1 sym (cadr upat) matches code vars rest)) | 469 | (pcase--q1 sym (cadr upat) matches code vars rest)) |
| 463 | ((eq (car-safe upat) 'or) | 470 | ((eq (car-safe upat) 'or) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 91ba9e5a359..b40c6b7d60f 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,81 @@ | |||
| 1 | 2011-02-18 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * auth-source.el (auth-source-search): Don't try to create credentials | ||
| 4 | if the caller doesn't want that. | ||
| 5 | |||
| 6 | * nnimap.el (nnimap-log-command): Add a newline to the inhibited | ||
| 7 | logging. | ||
| 8 | (nnimap-credentials): Protect against auth-source-search returning nil. | ||
| 9 | (nnimap-request-list): Protect against not being able to open the | ||
| 10 | server. | ||
| 11 | |||
| 12 | 2011-02-17 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 13 | |||
| 14 | * auth-source.el (auth-source-search): Do a two-phase search, one with | ||
| 15 | no :create to get the responses from all backends. | ||
| 16 | |||
| 17 | * nnimap.el (nnimap-open-connection-1): Delete duplicate server names | ||
| 18 | when getting credentials. | ||
| 19 | |||
| 20 | * gnus-util.el (gnus-delete-duplicates): New function. | ||
| 21 | |||
| 22 | 2011-02-17 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 23 | |||
| 24 | * nnimap.el (nnimap-credentials): Instead of picking the first port as | ||
| 25 | a creation default, pass the whole port list down. It will be | ||
| 26 | completed. | ||
| 27 | |||
| 28 | * auth-source.el (auth-source-search): Updated docs to talk about | ||
| 29 | multiple creation choices. | ||
| 30 | (auth-source-netrc-create): Accept a list as a value (from the search | ||
| 31 | parameters) and do completion on that list. Keep a separate netrc line | ||
| 32 | with the password obscured for showing the user. | ||
| 33 | |||
| 34 | * nnimap.el (nnimap-open-connection-1): Make the `nnimap-address' the | ||
| 35 | first choice to `auth-source-search' so it will be used for entry | ||
| 36 | creation instead of the server's Gnus-specific name. | ||
| 37 | (nnimap-credentials): Rely on the auth-source library to select which | ||
| 38 | port is actually wanted in the new netrc entry, so don't override | ||
| 39 | `auth-source-creation-defaults'. | ||
| 40 | |||
| 41 | * auth-source.el (auth-source-netrc-parse): Use :port instead of | ||
| 42 | :protocol and accept a missing user, host, or port as a wildcard match. | ||
| 43 | (auth-source-debug): Default to off. | ||
| 44 | |||
| 45 | (auth-source-netrc-search, auth-source-netrc-create) | ||
| 46 | (auth-source-secrets-search, auth-source-secrets-create) | ||
| 47 | (auth-source-user-or-password, auth-source-backend, auth-sources) | ||
| 48 | (auth-source-backend-parse-parameters, auth-source-search): Use :port | ||
| 49 | instead of :protocol. | ||
| 50 | |||
| 51 | * nnimap.el (nnimap-credentials): Pass a port default to | ||
| 52 | `auth-source-search' in case an entry needs to be created. | ||
| 53 | (nnimap-open-connection-1): Use :port instead of :protocol. | ||
| 54 | |||
| 55 | 2011-02-17 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 56 | |||
| 57 | * auth-source.el (auth-source-secrets-search): Use mm-delete-duplicates | ||
| 58 | instead of delete-dups that is not available in XEmacs 21.4. | ||
| 59 | |||
| 60 | 2011-02-16 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 61 | |||
| 62 | * gnus-sum.el (gnus-propagate-marks): Change default to t again, since | ||
| 63 | nil means that nnimap doesn't get updated. | ||
| 64 | |||
| 65 | 2011-02-16 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 66 | |||
| 67 | * auth-source.el (auth-source-netrc-create): Return a synthetic search | ||
| 68 | result when the user doesn't want to write to the file. | ||
| 69 | (auth-source-netrc-search): Expect a synthetic result and proceed | ||
| 70 | accordingly. | ||
| 71 | (auth-source-cache-expiry): New variable to override | ||
| 72 | `password-cache-expiry'. | ||
| 73 | (auth-source-remember): Use it. | ||
| 74 | |||
| 75 | * nnimap.el (nnimap-credentials): Remove the `inhibit-create' | ||
| 76 | parameter. Create entry if necessary by using :create t. | ||
| 77 | (nnimap-open-connection-1): Don't pass `inhibit-create'. | ||
| 78 | |||
| 1 | 2011-02-15 Teodor Zlatanov <tzz@lifelogs.com> | 79 | 2011-02-15 Teodor Zlatanov <tzz@lifelogs.com> |
| 2 | 80 | ||
| 3 | * auth-source.el (auth-source-debug): Enable by default and don't | 81 | * auth-source.el (auth-source-debug): Enable by default and don't |
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index a259c5c2f0b..4fdf521b1a9 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -40,6 +40,7 @@ | |||
| 40 | ;;; Code: | 40 | ;;; Code: |
| 41 | 41 | ||
| 42 | (require 'password-cache) | 42 | (require 'password-cache) |
| 43 | (require 'mm-util) | ||
| 43 | (require 'gnus-util) | 44 | (require 'gnus-util) |
| 44 | (require 'netrc) | 45 | (require 'netrc) |
| 45 | (require 'assoc) | 46 | (require 'assoc) |
| @@ -61,6 +62,18 @@ | |||
| 61 | :version "23.1" ;; No Gnus | 62 | :version "23.1" ;; No Gnus |
| 62 | :group 'gnus) | 63 | :group 'gnus) |
| 63 | 64 | ||
| 65 | ;;;###autoload | ||
| 66 | (defcustom auth-source-cache-expiry 7200 | ||
| 67 | "How many seconds passwords are cached, or nil to disable | ||
| 68 | expiring. Overrides `password-cache-expiry' through a | ||
| 69 | let-binding." | ||
| 70 | :group 'auth-source | ||
| 71 | :type '(choice (const :tag "Never" nil) | ||
| 72 | (const :tag "All Day" 86400) | ||
| 73 | (const :tag "2 Hours" 7200) | ||
| 74 | (const :tag "30 Minutes" 1800) | ||
| 75 | (integer :tag "Seconds"))) | ||
| 76 | |||
| 64 | (defclass auth-source-backend () | 77 | (defclass auth-source-backend () |
| 65 | ((type :initarg :type | 78 | ((type :initarg :type |
| 66 | :initform 'netrc | 79 | :initform 'netrc |
| @@ -81,11 +94,11 @@ | |||
| 81 | :type t | 94 | :type t |
| 82 | :custom string | 95 | :custom string |
| 83 | :documentation "The backend user.") | 96 | :documentation "The backend user.") |
| 84 | (protocol :initarg :protocol | 97 | (port :initarg :port |
| 85 | :initform t | 98 | :initform t |
| 86 | :type t | 99 | :type t |
| 87 | :custom string | 100 | :custom string |
| 88 | :documentation "The backend protocol.") | 101 | :documentation "The backend protocol.") |
| 89 | (create-function :initarg :create-function | 102 | (create-function :initarg :create-function |
| 90 | :initform ignore | 103 | :initform ignore |
| 91 | :type function | 104 | :type function |
| @@ -135,7 +148,7 @@ | |||
| 135 | :version "23.2" ;; No Gnus | 148 | :version "23.2" ;; No Gnus |
| 136 | :type `boolean) | 149 | :type `boolean) |
| 137 | 150 | ||
| 138 | (defcustom auth-source-debug t | 151 | (defcustom auth-source-debug nil |
| 139 | "Whether auth-source should log debug messages. | 152 | "Whether auth-source should log debug messages. |
| 140 | 153 | ||
| 141 | If the value is nil, debug messages are not logged. | 154 | If the value is nil, debug messages are not logged. |
| @@ -200,7 +213,7 @@ can get pretty complex." | |||
| 200 | :tag "Regular expression"))) | 213 | :tag "Regular expression"))) |
| 201 | (list | 214 | (list |
| 202 | :tag "Protocol" | 215 | :tag "Protocol" |
| 203 | (const :format "" :value :protocol) | 216 | (const :format "" :value :port) |
| 204 | (choice | 217 | (choice |
| 205 | :tag "Protocol" | 218 | :tag "Protocol" |
| 206 | (const :tag "Any" t) | 219 | (const :tag "Any" t) |
| @@ -253,19 +266,19 @@ If the value is not a list, symmetric encryption will be used." | |||
| 253 | msg)) | 266 | msg)) |
| 254 | 267 | ||
| 255 | 268 | ||
| 256 | ;; (auth-source-pick nil :host "any" :protocol 'imap :user "joe") | 269 | ;; (auth-source-pick nil :host "any" :port 'imap :user "joe") |
| 257 | ;; (auth-source-pick t :host "any" :protocol 'imap :user "joe") | 270 | ;; (auth-source-pick t :host "any" :port 'imap :user "joe") |
| 258 | ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") | 271 | ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") |
| 259 | ;; (:source (:secrets "session") :host t :protocol t :user "joe") | 272 | ;; (:source (:secrets "session") :host t :port t :user "joe") |
| 260 | ;; (:source (:secrets "Login") :host t :protocol t) | 273 | ;; (:source (:secrets "Login") :host t :port t) |
| 261 | ;; (:source "~/.authinfo.gpg" :host t :protocol t))) | 274 | ;; (:source "~/.authinfo.gpg" :host t :port t))) |
| 262 | 275 | ||
| 263 | ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") | 276 | ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") |
| 264 | ;; (:source (:secrets "session") :host t :protocol t :user "joe") | 277 | ;; (:source (:secrets "session") :host t :port t :user "joe") |
| 265 | ;; (:source (:secrets "Login") :host t :protocol t) | 278 | ;; (:source (:secrets "Login") :host t :port t) |
| 266 | ;; )) | 279 | ;; )) |
| 267 | 280 | ||
| 268 | ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) | 281 | ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t))) |
| 269 | 282 | ||
| 270 | ;; (auth-source-backend-parse "myfile.gpg") | 283 | ;; (auth-source-backend-parse "myfile.gpg") |
| 271 | ;; (auth-source-backend-parse 'default) | 284 | ;; (auth-source-backend-parse 'default) |
| @@ -342,8 +355,8 @@ If the value is not a list, symmetric encryption will be used." | |||
| 342 | 355 | ||
| 343 | (defun auth-source-backend-parse-parameters (entry backend) | 356 | (defun auth-source-backend-parse-parameters (entry backend) |
| 344 | "Fills in the extra auth-source-backend parameters of ENTRY. | 357 | "Fills in the extra auth-source-backend parameters of ENTRY. |
| 345 | Using the plist ENTRY, get the :host, :protocol, and :user search | 358 | Using the plist ENTRY, get the :host, :port, and :user search |
| 346 | parameters. Accepts :port as an alias to :protocol." | 359 | parameters." |
| 347 | (let ((entry (if (stringp entry) | 360 | (let ((entry (if (stringp entry) |
| 348 | nil | 361 | nil |
| 349 | entry)) | 362 | entry)) |
| @@ -352,15 +365,14 @@ parameters. Accepts :port as an alias to :protocol." | |||
| 352 | (oset backend host val)) | 365 | (oset backend host val)) |
| 353 | (when (setq val (plist-get entry :user)) | 366 | (when (setq val (plist-get entry :user)) |
| 354 | (oset backend user val)) | 367 | (oset backend user val)) |
| 355 | ;; accept :port as an alias for :protocol | 368 | (when (setq val (plist-get entry :port)) |
| 356 | (when (setq val (or (plist-get entry :protocol) (plist-get entry :port))) | 369 | (oset backend port val))) |
| 357 | (oset backend protocol val))) | ||
| 358 | backend) | 370 | backend) |
| 359 | 371 | ||
| 360 | ;; (mapcar 'auth-source-backend-parse auth-sources) | 372 | ;; (mapcar 'auth-source-backend-parse auth-sources) |
| 361 | 373 | ||
| 362 | (defun* auth-source-search (&rest spec | 374 | (defun* auth-source-search (&rest spec |
| 363 | &key type max host user protocol secret | 375 | &key type max host user port secret |
| 364 | create delete | 376 | create delete |
| 365 | &allow-other-keys) | 377 | &allow-other-keys) |
| 366 | "Search or modify authentication backends according to SPEC. | 378 | "Search or modify authentication backends according to SPEC. |
| @@ -373,7 +385,7 @@ other properties will always hold scalar values. | |||
| 373 | 385 | ||
| 374 | Typically the :secret property, if present, contains a password. | 386 | Typically the :secret property, if present, contains a password. |
| 375 | 387 | ||
| 376 | Common search keys are :max, :host, :protocol, and :user. In | 388 | Common search keys are :max, :host, :port, and :user. In |
| 377 | addition, :create specifies how tokens will be or created. | 389 | addition, :create specifies how tokens will be or created. |
| 378 | Finally, :type can specify which backend types you want to check. | 390 | Finally, :type can specify which backend types you want to check. |
| 379 | 391 | ||
| @@ -387,7 +399,7 @@ any of the search terms matches). | |||
| 387 | A new token will be created if no matching tokens were found. | 399 | A new token will be created if no matching tokens were found. |
| 388 | The new token will have only the keys the backend requires. For | 400 | The new token will have only the keys the backend requires. For |
| 389 | the netrc backend, for instance, that's the user, host, and | 401 | the netrc backend, for instance, that's the user, host, and |
| 390 | protocol keys. | 402 | port keys. |
| 391 | 403 | ||
| 392 | Here's an example: | 404 | Here's an example: |
| 393 | 405 | ||
| @@ -403,11 +415,11 @@ which says: | |||
| 403 | 'netrc', maximum one result. | 415 | 'netrc', maximum one result. |
| 404 | 416 | ||
| 405 | Create a new entry if you found none. The netrc backend will | 417 | Create a new entry if you found none. The netrc backend will |
| 406 | automatically require host, user, and protocol. The host will be | 418 | automatically require host, user, and port. The host will be |
| 407 | 'mine'. We prompt for the user with default 'defaultUser' and | 419 | 'mine'. We prompt for the user with default 'defaultUser' and |
| 408 | for the protocol without a default. We will not prompt for A, Q, | 420 | for the port without a default. We will not prompt for A, Q, |
| 409 | or P. The resulting token will only have keys user, host, and | 421 | or P. The resulting token will only have keys user, host, and |
| 410 | protocol.\" | 422 | port.\" |
| 411 | 423 | ||
| 412 | :create '(A B C) also means to create a token if possible. | 424 | :create '(A B C) also means to create a token if possible. |
| 413 | 425 | ||
| @@ -432,17 +444,17 @@ which says: | |||
| 432 | or 'twosuch' in backends of type 'netrc', maximum one result. | 444 | or 'twosuch' in backends of type 'netrc', maximum one result. |
| 433 | 445 | ||
| 434 | Create a new entry if you found none. The netrc backend will | 446 | Create a new entry if you found none. The netrc backend will |
| 435 | automatically require host, user, and protocol. The host will be | 447 | automatically require host, user, and port. The host will be |
| 436 | 'nonesuch' and Q will be 'qqqq'. We prompt for A with default | 448 | 'nonesuch' and Q will be 'qqqq'. We prompt for A with default |
| 437 | 'default A', for B and protocol with default nil, and for the | 449 | 'default A', for B and port with default nil, and for the |
| 438 | user with default 'defaultUser'. We will not prompt for Q. The | 450 | user with default 'defaultUser'. We will not prompt for Q. The |
| 439 | resulting token will have keys user, host, protocol, A, B, and Q. | 451 | resulting token will have keys user, host, port, A, B, and Q. |
| 440 | It will not have P with any value, even though P is used in the | 452 | It will not have P with any value, even though P is used in the |
| 441 | search to find only entries that have P set to 'pppp'.\" | 453 | search to find only entries that have P set to 'pppp'.\" |
| 442 | 454 | ||
| 443 | When multiple values are specified in the search parameter, the | 455 | When multiple values are specified in the search parameter, the |
| 444 | first one is used for creation. So :host (X Y Z) would create a | 456 | user is prompted for which one. So :host (X Y Z) would ask the |
| 445 | token for host X, for instance. | 457 | user to choose between X, Y, and Z. |
| 446 | 458 | ||
| 447 | This creation can fail if the search was not specific enough to | 459 | This creation can fail if the search was not specific enough to |
| 448 | create a new token (it's up to the backend to decide that). You | 460 | create a new token (it's up to the backend to decide that). You |
| @@ -468,14 +480,14 @@ the match rules above. Defaults to t. | |||
| 468 | :user (X Y Z) means to match only users X, Y, or Z according to | 480 | :user (X Y Z) means to match only users X, Y, or Z according to |
| 469 | the match rules above. Defaults to t. | 481 | the match rules above. Defaults to t. |
| 470 | 482 | ||
| 471 | :protocol (P Q R) means to match only protocols P, Q, or R. | 483 | :port (P Q R) means to match only protocols P, Q, or R. |
| 472 | Defaults to t. | 484 | Defaults to t. |
| 473 | 485 | ||
| 474 | :K (V1 V2 V3) for any other key K will match values V1, V2, or | 486 | :K (V1 V2 V3) for any other key K will match values V1, V2, or |
| 475 | V3 (note the match rules above). | 487 | V3 (note the match rules above). |
| 476 | 488 | ||
| 477 | The return value is a list with at most :max tokens. Each token | 489 | The return value is a list with at most :max tokens. Each token |
| 478 | is a plist with keys :backend :host :protocol :user, plus any other | 490 | is a plist with keys :backend :host :port :user, plus any other |
| 479 | keys provided by the backend (notably :secret). But note the | 491 | keys provided by the backend (notably :secret). But note the |
| 480 | exception for :max 0, which see above. | 492 | exception for :max 0, which see above. |
| 481 | 493 | ||
| @@ -488,7 +500,7 @@ must call it to obtain the actual value." | |||
| 488 | unless (memq (nth i spec) ignored-keys) | 500 | unless (memq (nth i spec) ignored-keys) |
| 489 | collect (nth i spec))) | 501 | collect (nth i spec))) |
| 490 | (found (auth-source-recall spec)) | 502 | (found (auth-source-recall spec)) |
| 491 | filtered-backends accessor-key found-here goal) | 503 | filtered-backends accessor-key found-here goal matches) |
| 492 | 504 | ||
| 493 | (if (and found auth-source-do-cache) | 505 | (if (and found auth-source-do-cache) |
| 494 | (auth-source-do-debug | 506 | (auth-source-do-debug |
| @@ -517,38 +529,58 @@ must call it to obtain the actual value." | |||
| 517 | 529 | ||
| 518 | ;; (debug spec "filtered" filtered-backends) | 530 | ;; (debug spec "filtered" filtered-backends) |
| 519 | (setq goal max) | 531 | (setq goal max) |
| 520 | (dolist (backend filtered-backends) | 532 | ;; First go through all the backends without :create, so we can |
| 521 | (setq found-here (apply | 533 | ;; query them all. |
| 522 | (slot-value backend 'search-function) | 534 | (let ((uspec (copy-sequence spec))) |
| 523 | :backend backend | 535 | (plist-put uspec :create nil) |
| 524 | :create create | 536 | (dolist (backend filtered-backends) |
| 525 | :delete delete | 537 | (let ((match (apply |
| 526 | spec)) | 538 | (slot-value backend 'search-function) |
| 527 | 539 | :backend backend | |
| 528 | ;; if max is 0, as soon as we find something, return it | 540 | uspec))) |
| 529 | (when (and (zerop max) (> 0 (length found-here))) | 541 | (when match |
| 530 | (return t)) | 542 | (push (list backend match) matches))))) |
| 531 | 543 | ;; If we didn't find anything, then we allow the backend(s) to | |
| 532 | ;; decrement the goal by the number of new results | 544 | ;; create the entries. |
| 533 | (decf goal (length found-here)) | 545 | (when (and create |
| 534 | ;; and append the new results to the full list | 546 | (not matches)) |
| 535 | (setq found (append found found-here)) | 547 | (let ((match (apply |
| 536 | 548 | (slot-value backend 'search-function) | |
| 537 | (auth-source-do-debug | 549 | :backend backend |
| 538 | "auth-source-search: found %d results (max %d/%d) in %S matching %S" | 550 | :create create |
| 539 | (length found-here) max goal backend spec) | 551 | :delete delete |
| 540 | 552 | spec))) | |
| 541 | ;; return full list if the goal is 0 or negative | 553 | (when match |
| 542 | (when (zerop (max 0 goal)) | 554 | (push (list backend match) matches)))) |
| 543 | (return found)) | 555 | |
| 544 | 556 | (setq backend (caar matches) | |
| 545 | ;; change the :max parameter in the spec to the goal | 557 | found-here (cadar matches)) |
| 546 | (setq spec (plist-put spec :max goal))) | 558 | |
| 547 | 559 | (block nil | |
| 548 | (when (and found auth-source-do-cache) | 560 | ;; if max is 0, as soon as we find something, return it |
| 549 | (auth-source-remember spec found))) | 561 | (when (and (zerop max) (> 0 (length found-here))) |
| 550 | 562 | (return t)) | |
| 551 | found)) | 563 | |
| 564 | ;; decrement the goal by the number of new results | ||
| 565 | (decf goal (length found-here)) | ||
| 566 | ;; and append the new results to the full list | ||
| 567 | (setq found (append found found-here)) | ||
| 568 | |||
| 569 | (auth-source-do-debug | ||
| 570 | "auth-source-search: found %d results (max %d/%d) in %S matching %S" | ||
| 571 | (length found-here) max goal backend spec) | ||
| 572 | |||
| 573 | ;; return full list if the goal is 0 or negative | ||
| 574 | (when (zerop (max 0 goal)) | ||
| 575 | (return found)) | ||
| 576 | |||
| 577 | ;; change the :max parameter in the spec to the goal | ||
| 578 | (setq spec (plist-put spec :max goal)) | ||
| 579 | |||
| 580 | (when (and found auth-source-do-cache) | ||
| 581 | (auth-source-remember spec found)))) | ||
| 582 | |||
| 583 | found)) | ||
| 552 | 584 | ||
| 553 | ;;; (auth-source-search :max 1) | 585 | ;;; (auth-source-search :max 1) |
| 554 | ;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) | 586 | ;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) |
| @@ -588,8 +620,9 @@ Returns the deleted entries." | |||
| 588 | 620 | ||
| 589 | (defun auth-source-remember (spec found) | 621 | (defun auth-source-remember (spec found) |
| 590 | "Remember FOUND search results for SPEC." | 622 | "Remember FOUND search results for SPEC." |
| 591 | (password-cache-add | 623 | (let ((password-cache-expiry auth-source-cache-expiry)) |
| 592 | (concat auth-source-magic (format "%S" spec)) found)) | 624 | (password-cache-add |
| 625 | (concat auth-source-magic (format "%S" spec)) found))) | ||
| 593 | 626 | ||
| 594 | (defun auth-source-recall (spec) | 627 | (defun auth-source-recall (spec) |
| 595 | "Recall FOUND search results for SPEC." | 628 | "Recall FOUND search results for SPEC." |
| @@ -648,7 +681,7 @@ while \(:host t) would find all host entries." | |||
| 648 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") | 681 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") |
| 649 | (defun* auth-source-netrc-parse (&rest | 682 | (defun* auth-source-netrc-parse (&rest |
| 650 | spec | 683 | spec |
| 651 | &key file max host user protocol delete | 684 | &key file max host user port delete |
| 652 | &allow-other-keys) | 685 | &allow-other-keys) |
| 653 | "Parse FILE and return a list of all entries in the file. | 686 | "Parse FILE and return a list of all entries in the file. |
| 654 | Note that the MAX parameter is used so we can exit the parse early." | 687 | Note that the MAX parameter is used so we can exit the parse early." |
| @@ -710,18 +743,21 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 710 | host | 743 | host |
| 711 | (or | 744 | (or |
| 712 | (aget alist "machine") | 745 | (aget alist "machine") |
| 713 | (aget alist "host"))) | 746 | (aget alist "host") |
| 747 | t)) | ||
| 714 | (auth-source-search-collection | 748 | (auth-source-search-collection |
| 715 | user | 749 | user |
| 716 | (or | 750 | (or |
| 717 | (aget alist "login") | 751 | (aget alist "login") |
| 718 | (aget alist "account") | 752 | (aget alist "account") |
| 719 | (aget alist "user"))) | 753 | (aget alist "user") |
| 754 | t)) | ||
| 720 | (auth-source-search-collection | 755 | (auth-source-search-collection |
| 721 | protocol | 756 | port |
| 722 | (or | 757 | (or |
| 723 | (aget alist "port") | 758 | (aget alist "port") |
| 724 | (aget alist "protocol")))) | 759 | (aget alist "protocol") |
| 760 | t))) | ||
| 725 | (decf max) | 761 | (decf max) |
| 726 | (push (nreverse alist) result) | 762 | (push (nreverse alist) result) |
| 727 | ;; to delete a line, we just comment it out | 763 | ;; to delete a line, we just comment it out |
| @@ -787,7 +823,7 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 787 | (defun* auth-source-netrc-search (&rest | 823 | (defun* auth-source-netrc-search (&rest |
| 788 | spec | 824 | spec |
| 789 | &key backend create delete | 825 | &key backend create delete |
| 790 | type max host user protocol | 826 | type max host user port |
| 791 | &allow-other-keys) | 827 | &allow-other-keys) |
| 792 | "Given a property list SPEC, return search matches from the :backend. | 828 | "Given a property list SPEC, return search matches from the :backend. |
| 793 | See `auth-source-search' for details on SPEC." | 829 | See `auth-source-search' for details on SPEC." |
| @@ -802,20 +838,23 @@ See `auth-source-search' for details on SPEC." | |||
| 802 | :file (oref backend source) | 838 | :file (oref backend source) |
| 803 | :host (or host t) | 839 | :host (or host t) |
| 804 | :user (or user t) | 840 | :user (or user t) |
| 805 | :protocol (or protocol t))))) | 841 | :port (or port t))))) |
| 806 | 842 | ||
| 807 | ;; if we need to create an entry AND none were found to match | 843 | ;; if we need to create an entry AND none were found to match |
| 808 | (when (and create | 844 | (when (and create |
| 809 | (= 0 (length results))) | 845 | (= 0 (length results))) |
| 810 | 846 | ||
| 811 | ;; create based on the spec | 847 | ;; create based on the spec and record the value |
| 812 | (apply (slot-value backend 'create-function) spec) | 848 | (setq results (or |
| 813 | ;; turn off the :create key | 849 | ;; if the user did not want to create the entry |
| 814 | (setq spec (plist-put spec :create nil)) | 850 | ;; in the file, it will be returned |
| 815 | ;; run the search again to get the updated data | 851 | (apply (slot-value backend 'create-function) spec) |
| 816 | ;; the result will be returned, even if the search fails | 852 | ;; if not, we do the search again without :create |
| 817 | (setq results (apply 'auth-source-netrc-search spec))) | 853 | ;; to get the updated data. |
| 818 | 854 | ||
| 855 | ;; the result will be returned, even if the search fails | ||
| 856 | (apply 'auth-source-netrc-search | ||
| 857 | (plist-put spec :create nil))))) | ||
| 819 | results)) | 858 | results)) |
| 820 | 859 | ||
| 821 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) | 860 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) |
| @@ -823,26 +862,33 @@ See `auth-source-search' for details on SPEC." | |||
| 823 | 862 | ||
| 824 | (defun* auth-source-netrc-create (&rest spec | 863 | (defun* auth-source-netrc-create (&rest spec |
| 825 | &key backend | 864 | &key backend |
| 826 | secret host user protocol create | 865 | secret host user port create |
| 827 | &allow-other-keys) | 866 | &allow-other-keys) |
| 828 | (let* ((base-required '(host user protocol secret)) | 867 | (let* ((base-required '(host user port secret)) |
| 829 | ;; we know (because of an assertion in auth-source-search) that the | 868 | ;; we know (because of an assertion in auth-source-search) that the |
| 830 | ;; :create parameter is either t or a list (which includes nil) | 869 | ;; :create parameter is either t or a list (which includes nil) |
| 831 | (create-extra (if (eq t create) nil create)) | 870 | (create-extra (if (eq t create) nil create)) |
| 832 | (required (append base-required create-extra)) | 871 | (required (append base-required create-extra)) |
| 833 | (file (oref backend source)) | 872 | (file (oref backend source)) |
| 834 | (add "") | 873 | (add "") |
| 874 | (show "") | ||
| 835 | ;; `valist' is an alist | 875 | ;; `valist' is an alist |
| 836 | valist) | 876 | valist |
| 877 | ;; `artificial' will be returned if no creation is needed | ||
| 878 | artificial) | ||
| 837 | 879 | ||
| 838 | ;; only for base required elements (defined as function parameters): | 880 | ;; only for base required elements (defined as function parameters): |
| 839 | ;; fill in the valist with whatever data we may have from the search | 881 | ;; fill in the valist with whatever data we may have from the search |
| 840 | ;; we take the first value if it's a list, the whole value otherwise | 882 | ;; we complete the first value if it's a list and use the value otherwise |
| 841 | (dolist (br base-required) | 883 | (dolist (br base-required) |
| 842 | (when (symbol-value br) | 884 | (when (symbol-value br) |
| 843 | (aput 'valist br (if (listp (symbol-value br)) | 885 | (let ((br-choice (cond |
| 844 | (nth 0 (symbol-value br)) | 886 | ;; all-accepting choice (predicate is t) |
| 845 | (symbol-value br))))) | 887 | ((eq t (symbol-value br)) nil) |
| 888 | ;; just the value otherwise | ||
| 889 | (t (symbol-value br))))) | ||
| 890 | (when br-choice | ||
| 891 | (aput 'valist br br-choice))))) | ||
| 846 | 892 | ||
| 847 | ;; for extra required elements, see if the spec includes a value for them | 893 | ;; for extra required elements, see if the spec includes a value for them |
| 848 | (dolist (er create-extra) | 894 | (dolist (er create-extra) |
| @@ -862,7 +908,7 @@ See `auth-source-search' for details on SPEC." | |||
| 862 | ((and (not given-default) (eq r 'user)) | 908 | ((and (not given-default) (eq r 'user)) |
| 863 | (user-login-name)) | 909 | (user-login-name)) |
| 864 | ;; note we need this empty string | 910 | ;; note we need this empty string |
| 865 | ((and (not given-default) (eq r 'protocol)) | 911 | ((and (not given-default) (eq r 'port)) |
| 866 | "") | 912 | "") |
| 867 | (t given-default))) | 913 | (t given-default))) |
| 868 | ;; the prompt's default string depends on the data so far | 914 | ;; the prompt's default string depends on the data so far |
| @@ -872,20 +918,22 @@ See `auth-source-search' for details on SPEC." | |||
| 872 | ;; the prompt should also show what's entered so far | 918 | ;; the prompt should also show what's entered so far |
| 873 | (user-value (aget valist 'user)) | 919 | (user-value (aget valist 'user)) |
| 874 | (host-value (aget valist 'host)) | 920 | (host-value (aget valist 'host)) |
| 875 | (protocol-value (aget valist 'protocol)) | 921 | (port-value (aget valist 'port)) |
| 922 | ;; note this handles lists by just printing them | ||
| 923 | ;; later we allow the user to use completing-read to pick | ||
| 876 | (info-so-far (concat (if user-value | 924 | (info-so-far (concat (if user-value |
| 877 | (format "%s@" user-value) | 925 | (format "%s@" user-value) |
| 878 | "[USER?]") | 926 | "[USER?]") |
| 879 | (if host-value | 927 | (if host-value |
| 880 | (format "%s" host-value) | 928 | (format "%s" host-value) |
| 881 | "[HOST?]") | 929 | "[HOST?]") |
| 882 | (if protocol-value | 930 | (if port-value |
| 883 | ;; this distinguishes protocol between | 931 | ;; this distinguishes protocol between |
| 884 | (if (zerop (length protocol-value)) | 932 | (if (zerop (length port-value)) |
| 885 | "" ; 'entered as "no default"' vs. | 933 | "" ; 'entered as "no default"' vs. |
| 886 | (format ":%s" protocol-value)) ; given | 934 | (format ":%s" port-value)) ; given |
| 887 | ;; and this is when the protocol is unknown | 935 | ;; and this is when the protocol is unknown |
| 888 | "[PROTOCOL?]")))) | 936 | "[PORT?]")))) |
| 889 | 937 | ||
| 890 | ;; now prompt if the search SPEC did not include a required key; | 938 | ;; now prompt if the search SPEC did not include a required key; |
| 891 | ;; take the result and put it in `data' AND store it in `valist' | 939 | ;; take the result and put it in `data' AND store it in `valist' |
| @@ -900,25 +948,48 @@ See `auth-source-search' for details on SPEC." | |||
| 900 | (format "Enter %s for %s%s: " | 948 | (format "Enter %s for %s%s: " |
| 901 | r info-so-far default-string) | 949 | r info-so-far default-string) |
| 902 | nil nil default)) | 950 | nil nil default)) |
| 951 | ((listp data) | ||
| 952 | (completing-read | ||
| 953 | (format "Enter %s for %s (TAB to see the choices): " | ||
| 954 | r info-so-far) | ||
| 955 | data | ||
| 956 | nil ; no predicate | ||
| 957 | t ; require a match | ||
| 958 | ;; note the default is nil, but if the user | ||
| 959 | ;; hits RET we'll get "", which is handled OK later | ||
| 960 | nil)) | ||
| 903 | (t data)))) | 961 | (t data)))) |
| 904 | 962 | ||
| 963 | (when data | ||
| 964 | (setq artificial (plist-put artificial | ||
| 965 | (intern (concat ":" (symbol-name r))) | ||
| 966 | (if (eq r 'secret) | ||
| 967 | (lexical-let ((data data)) | ||
| 968 | (lambda () data)) | ||
| 969 | data)))) | ||
| 970 | |||
| 905 | ;; when r is not an empty string... | 971 | ;; when r is not an empty string... |
| 906 | (when (and (stringp data) | 972 | (when (and (stringp data) |
| 907 | (< 0 (length data))) | 973 | (< 0 (length data))) |
| 908 | ;; append the key (the symbol name of r) and the value in r | 974 | (let ((printer (lambda (hide) |
| 909 | (setq add (concat add | 975 | ;; append the key (the symbol name of r) |
| 910 | (format "%s%s %S" | 976 | ;; and the value in r |
| 911 | ;; prepend a space | 977 | (format "%s%s %S" |
| 912 | (if (zerop (length add)) "" " ") | 978 | ;; prepend a space |
| 913 | ;; remap auth-source tokens to netrc | 979 | (if (zerop (length add)) "" " ") |
| 914 | (case r | 980 | ;; remap auth-source tokens to netrc |
| 981 | (case r | ||
| 915 | ('user "login") | 982 | ('user "login") |
| 916 | ('host "machine") | 983 | ('host "machine") |
| 917 | ('secret "password") | 984 | ('secret "password") |
| 918 | ('protocol "port") | 985 | ('port "port") ; redundant but clearer |
| 919 | (t (symbol-name r))) | 986 | (t (symbol-name r))) |
| 920 | ;; the value will be printed in %S format | 987 | ;; the value will be printed in %S format |
| 921 | data)))))) | 988 | (if (and hide (eq r 'secret)) |
| 989 | "HIDDEN_SECRET" | ||
| 990 | data))))) | ||
| 991 | (setq add (concat add (funcall printer nil))) | ||
| 992 | (setq show (concat show (funcall printer t))))))) | ||
| 922 | 993 | ||
| 923 | (with-temp-buffer | 994 | (with-temp-buffer |
| 924 | (when (file-exists-p file) | 995 | (when (file-exists-p file) |
| @@ -935,14 +1006,17 @@ See `auth-source-search' for details on SPEC." | |||
| 935 | (goto-char (point-max)) | 1006 | (goto-char (point-max)) |
| 936 | 1007 | ||
| 937 | ;; ask AFTER we've successfully opened the file | 1008 | ;; ask AFTER we've successfully opened the file |
| 938 | (when (y-or-n-p (format "Add to file %s: line [%s]" file add)) | 1009 | (if (y-or-n-p (format "Add to file %s: line [%s]" file show)) |
| 939 | (unless (bolp) | 1010 | (progn |
| 940 | (insert "\n")) | 1011 | (unless (bolp) |
| 941 | (insert add "\n") | 1012 | (insert "\n")) |
| 942 | (write-region (point-min) (point-max) file nil 'silent) | 1013 | (insert add "\n") |
| 943 | (auth-source-do-debug | 1014 | (write-region (point-min) (point-max) file nil 'silent) |
| 944 | "auth-source-netrc-create: wrote 1 new line to %s" | 1015 | (auth-source-do-debug |
| 945 | file))))) | 1016 | "auth-source-netrc-create: wrote 1 new line to %s" |
| 1017 | file) | ||
| 1018 | nil) | ||
| 1019 | (list artificial))))) | ||
| 946 | 1020 | ||
| 947 | ;;; Backend specific parsing: Secrets API backend | 1021 | ;;; Backend specific parsing: Secrets API backend |
| 948 | 1022 | ||
| @@ -956,7 +1030,7 @@ See `auth-source-search' for details on SPEC." | |||
| 956 | (defun* auth-source-secrets-search (&rest | 1030 | (defun* auth-source-secrets-search (&rest |
| 957 | spec | 1031 | spec |
| 958 | &key backend create delete label | 1032 | &key backend create delete label |
| 959 | type max host user protocol | 1033 | type max host user port |
| 960 | &allow-other-keys) | 1034 | &allow-other-keys) |
| 961 | "Search the Secrets API; spec is like `auth-source'. | 1035 | "Search the Secrets API; spec is like `auth-source'. |
| 962 | 1036 | ||
| @@ -1012,10 +1086,10 @@ authentication tokens: | |||
| 1012 | nil | 1086 | nil |
| 1013 | (list k (plist-get spec k)))) | 1087 | (list k (plist-get spec k)))) |
| 1014 | search-keys))) | 1088 | search-keys))) |
| 1015 | ;; needed keys (always including host, login, protocol, and secret) | 1089 | ;; needed keys (always including host, login, port, and secret) |
| 1016 | (returned-keys (delete-dups (append | 1090 | (returned-keys (mm-delete-duplicates (append |
| 1017 | '(:host :login :protocol :secret) | 1091 | '(:host :login :port :secret) |
| 1018 | search-keys))) | 1092 | search-keys))) |
| 1019 | (items (loop for item in (apply 'secrets-search-items coll search-spec) | 1093 | (items (loop for item in (apply 'secrets-search-items coll search-spec) |
| 1020 | unless (and (stringp label) | 1094 | unless (and (stringp label) |
| 1021 | (not (string-match label item))) | 1095 | (not (string-match label item))) |
| @@ -1051,7 +1125,7 @@ authentication tokens: | |||
| 1051 | 1125 | ||
| 1052 | (defun* auth-source-secrets-create (&rest | 1126 | (defun* auth-source-secrets-create (&rest |
| 1053 | spec | 1127 | spec |
| 1054 | &key backend type max host user protocol | 1128 | &key backend type max host user port |
| 1055 | &allow-other-keys) | 1129 | &allow-other-keys) |
| 1056 | ;; TODO | 1130 | ;; TODO |
| 1057 | ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) | 1131 | ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) |
| @@ -1068,8 +1142,8 @@ authentication tokens: | |||
| 1068 | 'auth-source-forget "Emacs 24.1") | 1142 | 'auth-source-forget "Emacs 24.1") |
| 1069 | 1143 | ||
| 1070 | (defun auth-source-user-or-password | 1144 | (defun auth-source-user-or-password |
| 1071 | (mode host protocol &optional username create-missing delete-existing) | 1145 | (mode host port &optional username create-missing delete-existing) |
| 1072 | "Find MODE (string or list of strings) matching HOST and PROTOCOL. | 1146 | "Find MODE (string or list of strings) matching HOST and PORT. |
| 1073 | 1147 | ||
| 1074 | DEPRECATED in favor of `auth-source-search'! | 1148 | DEPRECATED in favor of `auth-source-search'! |
| 1075 | 1149 | ||
| @@ -1092,14 +1166,14 @@ stored in the password database which matches best (see | |||
| 1092 | MODE can be \"login\" or \"password\"." | 1166 | MODE can be \"login\" or \"password\"." |
| 1093 | (auth-source-do-debug | 1167 | (auth-source-do-debug |
| 1094 | "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" | 1168 | "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" |
| 1095 | mode host protocol username) | 1169 | mode host port username) |
| 1096 | 1170 | ||
| 1097 | (let* ((listy (listp mode)) | 1171 | (let* ((listy (listp mode)) |
| 1098 | (mode (if listy mode (list mode))) | 1172 | (mode (if listy mode (list mode))) |
| 1099 | (cname (if username | 1173 | (cname (if username |
| 1100 | (format "%s %s:%s %s" mode host protocol username) | 1174 | (format "%s %s:%s %s" mode host port username) |
| 1101 | (format "%s %s:%s" mode host protocol))) | 1175 | (format "%s %s:%s" mode host port))) |
| 1102 | (search (list :host host :protocol protocol)) | 1176 | (search (list :host host :port port)) |
| 1103 | (search (if username (append search (list :user username)) search)) | 1177 | (search (if username (append search (list :user username)) search)) |
| 1104 | (search (if create-missing | 1178 | (search (if create-missing |
| 1105 | (append search (list :create t)) | 1179 | (append search (list :create t)) |
| @@ -1121,7 +1195,7 @@ MODE can be \"login\" or \"password\"." | |||
| 1121 | (if (and (member "password" mode) t) | 1195 | (if (and (member "password" mode) t) |
| 1122 | "SECRET" | 1196 | "SECRET" |
| 1123 | found) | 1197 | found) |
| 1124 | host protocol username) | 1198 | host port username) |
| 1125 | found) ; return the found data | 1199 | found) ; return the found data |
| 1126 | ;; else, if not found, search with a max of 1 | 1200 | ;; else, if not found, search with a max of 1 |
| 1127 | (let ((choice (nth 0 (apply 'auth-source-search | 1201 | (let ((choice (nth 0 (apply 'auth-source-search |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4dfc79a8883..619c8bd75fd 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -1234,11 +1234,10 @@ For example: ((1 . cn-gb-2312) (2 . big5))." | |||
| 1234 | :type 'boolean | 1234 | :type 'boolean |
| 1235 | :group 'gnus-summary-marks) | 1235 | :group 'gnus-summary-marks) |
| 1236 | 1236 | ||
| 1237 | (defcustom gnus-propagate-marks nil | 1237 | (defcustom gnus-propagate-marks t |
| 1238 | "If non-nil, Gnus will store and retrieve marks from the backends. | 1238 | "If non-nil, Gnus will store and retrieve marks from the backends. |
| 1239 | This means that marks will be stored both in .newsrc.eld and in | 1239 | This means that marks will be stored both in .newsrc.eld and in |
| 1240 | the backend, and will slow operation down somewhat." | 1240 | the backend, and will slow operation down somewhat." |
| 1241 | :version "24.1" | ||
| 1242 | :type 'boolean | 1241 | :type 'boolean |
| 1243 | :group 'gnus-summary-marks) | 1242 | :group 'gnus-summary-marks) |
| 1244 | 1243 | ||
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 67c49096b92..42dbd5948cf 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -871,6 +871,15 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and | |||
| 871 | (when (file-exists-p file) | 871 | (when (file-exists-p file) |
| 872 | (delete-file file))) | 872 | (delete-file file))) |
| 873 | 873 | ||
| 874 | (defun gnus-delete-duplicates (list) | ||
| 875 | "Remove duplicate entries from LIST." | ||
| 876 | (let ((result nil)) | ||
| 877 | (while list | ||
| 878 | (unless (member (car list) result) | ||
| 879 | (push (car list) result)) | ||
| 880 | (pop list)) | ||
| 881 | (nreverse result))) | ||
| 882 | |||
| 874 | (defun gnus-delete-directory (directory) | 883 | (defun gnus-delete-directory (directory) |
| 875 | "Delete files in DIRECTORY. Subdirectories remain. | 884 | "Delete files in DIRECTORY. Subdirectories remain. |
| 876 | If there's no subdirectory, delete DIRECTORY as well." | 885 | If there's no subdirectory, delete DIRECTORY as well." |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index a5a001f7e11..9c93ee8bbd9 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -276,18 +276,17 @@ textual parts.") | |||
| 276 | (push (current-buffer) nnimap-process-buffers) | 276 | (push (current-buffer) nnimap-process-buffers) |
| 277 | (current-buffer))) | 277 | (current-buffer))) |
| 278 | 278 | ||
| 279 | (defun nnimap-credentials (address ports &optional inhibit-create) | 279 | (defun nnimap-credentials (address ports) |
| 280 | (let* ((found (nth 0 (auth-source-search :max 1 | 280 | (let ((found (nth 0 (auth-source-search :max 1 |
| 281 | :host address | 281 | :host address |
| 282 | :port ports | 282 | :port ports |
| 283 | :create (if inhibit-create | 283 | :create t)))) |
| 284 | nil | ||
| 285 | (null ports))))) | ||
| 286 | (user (plist-get found :user)) | ||
| 287 | (secret (plist-get found :secret)) | ||
| 288 | (secret (if (functionp secret) (funcall secret) secret))) | ||
| 289 | (if found | 284 | (if found |
| 290 | (list user secret) | 285 | (list (plist-get found :user) |
| 286 | (let ((secret (plist-get found :secret))) | ||
| 287 | (if (functionp secret) | ||
| 288 | (funcall secret) | ||
| 289 | secret))) | ||
| 291 | nil))) | 290 | nil))) |
| 292 | 291 | ||
| 293 | (defun nnimap-keepalive () | 292 | (defun nnimap-keepalive () |
| @@ -386,10 +385,11 @@ textual parts.") | |||
| 386 | ;; Look for the credentials based on | 385 | ;; Look for the credentials based on |
| 387 | ;; the virtual server name and the address | 386 | ;; the virtual server name and the address |
| 388 | (nnimap-credentials | 387 | (nnimap-credentials |
| 389 | (list | 388 | (gnus-delete-duplicates |
| 390 | (nnoo-current-server 'nnimap) | 389 | (list |
| 391 | nnimap-address) | 390 | nnimap-address |
| 392 | ports t)))) | 391 | (nnoo-current-server 'nnimap))) |
| 392 | ports)))) | ||
| 393 | (setq nnimap-object nil) | 393 | (setq nnimap-object nil) |
| 394 | (let ((nnimap-inhibit-logging t)) | 394 | (let ((nnimap-inhibit-logging t)) |
| 395 | (setq login-result | 395 | (setq login-result |
| @@ -400,7 +400,7 @@ textual parts.") | |||
| 400 | (dolist (host (list (nnoo-current-server 'nnimap) | 400 | (dolist (host (list (nnoo-current-server 'nnimap) |
| 401 | nnimap-address)) | 401 | nnimap-address)) |
| 402 | (dolist (port ports) | 402 | (dolist (port ports) |
| 403 | (auth-source-forget+ :host host :protocol port))) | 403 | (auth-source-forget+ :host host :port port))) |
| 404 | (delete-process (nnimap-process nnimap-object)) | 404 | (delete-process (nnimap-process nnimap-object)) |
| 405 | (setq nnimap-object nil)))) | 405 | (setq nnimap-object nil)))) |
| 406 | (when nnimap-object | 406 | (when nnimap-object |
| @@ -1075,60 +1075,62 @@ textual parts.") | |||
| 1075 | (nreverse groups))) | 1075 | (nreverse groups))) |
| 1076 | 1076 | ||
| 1077 | (deffoo nnimap-request-list (&optional server) | 1077 | (deffoo nnimap-request-list (&optional server) |
| 1078 | (nnimap-possibly-change-group nil server) | 1078 | (when (nnimap-possibly-change-group nil server) |
| 1079 | (with-current-buffer nntp-server-buffer | 1079 | (with-current-buffer nntp-server-buffer |
| 1080 | (erase-buffer) | 1080 | (erase-buffer) |
| 1081 | (let ((groups | 1081 | (let ((groups |
| 1082 | (with-current-buffer (nnimap-buffer) | 1082 | (with-current-buffer (nnimap-buffer) |
| 1083 | (nnimap-get-groups))) | 1083 | (nnimap-get-groups))) |
| 1084 | sequences responses) | 1084 | sequences responses) |
| 1085 | (when groups | 1085 | (when groups |
| 1086 | (with-current-buffer (nnimap-buffer) | 1086 | (with-current-buffer (nnimap-buffer) |
| 1087 | (setf (nnimap-group nnimap-object) nil) | 1087 | (setf (nnimap-group nnimap-object) nil) |
| 1088 | (dolist (group groups) | 1088 | (dolist (group groups) |
| 1089 | (setf (nnimap-examined nnimap-object) group) | 1089 | (setf (nnimap-examined nnimap-object) group) |
| 1090 | (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) | 1090 | (push (list (nnimap-send-command "EXAMINE %S" |
| 1091 | group) | 1091 | (utf7-encode group t)) |
| 1092 | sequences)) | 1092 | group) |
| 1093 | (nnimap-wait-for-response (caar sequences)) | 1093 | sequences)) |
| 1094 | (setq responses | 1094 | (nnimap-wait-for-response (caar sequences)) |
| 1095 | (nnimap-get-responses (mapcar #'car sequences)))) | 1095 | (setq responses |
| 1096 | (dolist (response responses) | 1096 | (nnimap-get-responses (mapcar #'car sequences)))) |
| 1097 | (let* ((sequence (car response)) | 1097 | (dolist (response responses) |
| 1098 | (response (cadr response)) | 1098 | (let* ((sequence (car response)) |
| 1099 | (group (cadr (assoc sequence sequences)))) | 1099 | (response (cadr response)) |
| 1100 | (when (and group | 1100 | (group (cadr (assoc sequence sequences)))) |
| 1101 | (equal (caar response) "OK")) | 1101 | (when (and group |
| 1102 | (let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) | 1102 | (equal (caar response) "OK")) |
| 1103 | highest exists) | 1103 | (let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) |
| 1104 | (dolist (elem response) | 1104 | highest exists) |
| 1105 | (when (equal (cadr elem) "EXISTS") | 1105 | (dolist (elem response) |
| 1106 | (setq exists (string-to-number (car elem))))) | 1106 | (when (equal (cadr elem) "EXISTS") |
| 1107 | (when uidnext | 1107 | (setq exists (string-to-number (car elem))))) |
| 1108 | (setq highest (1- (string-to-number (car uidnext))))) | 1108 | (when uidnext |
| 1109 | (cond | 1109 | (setq highest (1- (string-to-number (car uidnext))))) |
| 1110 | ((null highest) | 1110 | (cond |
| 1111 | (insert (format "%S 0 1 y\n" (utf7-decode group t)))) | 1111 | ((null highest) |
| 1112 | ((zerop exists) | 1112 | (insert (format "%S 0 1 y\n" (utf7-decode group t)))) |
| 1113 | ;; Empty group. | 1113 | ((zerop exists) |
| 1114 | (insert (format "%S %d %d y\n" | 1114 | ;; Empty group. |
| 1115 | (utf7-decode group t) highest (1+ highest)))) | 1115 | (insert (format "%S %d %d y\n" |
| 1116 | (t | 1116 | (utf7-decode group t) |
| 1117 | ;; Return the widest possible range. | 1117 | highest (1+ highest)))) |
| 1118 | (insert (format "%S %d 1 y\n" (utf7-decode group t) | 1118 | (t |
| 1119 | (or highest exists))))))))) | 1119 | ;; Return the widest possible range. |
| 1120 | t)))) | 1120 | (insert (format "%S %d 1 y\n" (utf7-decode group t) |
| 1121 | (or highest exists))))))))) | ||
| 1122 | t))))) | ||
| 1121 | 1123 | ||
| 1122 | (deffoo nnimap-request-newgroups (date &optional server) | 1124 | (deffoo nnimap-request-newgroups (date &optional server) |
| 1123 | (nnimap-possibly-change-group nil server) | 1125 | (when (nnimap-possibly-change-group nil server) |
| 1124 | (with-current-buffer nntp-server-buffer | 1126 | (with-current-buffer nntp-server-buffer |
| 1125 | (erase-buffer) | 1127 | (erase-buffer) |
| 1126 | (dolist (group (with-current-buffer (nnimap-buffer) | 1128 | (dolist (group (with-current-buffer (nnimap-buffer) |
| 1127 | (nnimap-get-groups))) | 1129 | (nnimap-get-groups))) |
| 1128 | (unless (assoc group nnimap-current-infos) | 1130 | (unless (assoc group nnimap-current-infos) |
| 1129 | ;; Insert dummy numbers here -- they don't matter. | 1131 | ;; Insert dummy numbers here -- they don't matter. |
| 1130 | (insert (format "%S 0 1 y\n" group)))) | 1132 | (insert (format "%S 0 1 y\n" group)))) |
| 1131 | t)) | 1133 | t))) |
| 1132 | 1134 | ||
| 1133 | (deffoo nnimap-retrieve-group-data-early (server infos) | 1135 | (deffoo nnimap-retrieve-group-data-early (server infos) |
| 1134 | (when (nnimap-possibly-change-group nil server) | 1136 | (when (nnimap-possibly-change-group nil server) |
| @@ -1589,7 +1591,7 @@ textual parts.") | |||
| 1589 | (goto-char (point-max)) | 1591 | (goto-char (point-max)) |
| 1590 | (insert (format-time-string "%H:%M:%S") " " | 1592 | (insert (format-time-string "%H:%M:%S") " " |
| 1591 | (if nnimap-inhibit-logging | 1593 | (if nnimap-inhibit-logging |
| 1592 | "(inhibited)" | 1594 | "(inhibited)\n" |
| 1593 | command))) | 1595 | command))) |
| 1594 | command) | 1596 | command) |
| 1595 | 1597 | ||
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 8657dc58bf4..1d419dbfa18 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el | |||
| @@ -556,6 +556,11 @@ If ARG is non-nil, instead prompt for connection parameters." | |||
| 556 | `(with-current-buffer rcirc-server-buffer | 556 | `(with-current-buffer rcirc-server-buffer |
| 557 | ,@body)) | 557 | ,@body)) |
| 558 | 558 | ||
| 559 | (defun rcirc-float-time () | ||
| 560 | (if (featurep 'xemacs) | ||
| 561 | (time-to-seconds (current-time)) | ||
| 562 | (float-time))) | ||
| 563 | |||
| 559 | (defun rcirc-keepalive () | 564 | (defun rcirc-keepalive () |
| 560 | "Send keep alive pings to active rcirc processes. | 565 | "Send keep alive pings to active rcirc processes. |
| 561 | Kill processes that have not received a server message since the | 566 | Kill processes that have not received a server message since the |
| @@ -567,10 +572,7 @@ last ping." | |||
| 567 | (rcirc-send-ctcp process | 572 | (rcirc-send-ctcp process |
| 568 | rcirc-nick | 573 | rcirc-nick |
| 569 | (format "KEEPALIVE %f" | 574 | (format "KEEPALIVE %f" |
| 570 | (if (featurep 'xemacs) | 575 | (rcirc-float-time)))))) |
| 571 | (time-to-seconds | ||
| 572 | (current-time)) | ||
| 573 | (float-time))))))) | ||
| 574 | (rcirc-process-list)) | 576 | (rcirc-process-list)) |
| 575 | ;; no processes, clean up timer | 577 | ;; no processes, clean up timer |
| 576 | (cancel-timer rcirc-keepalive-timer) | 578 | (cancel-timer rcirc-keepalive-timer) |
| @@ -578,10 +580,7 @@ last ping." | |||
| 578 | 580 | ||
| 579 | (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) | 581 | (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) |
| 580 | (with-rcirc-process-buffer process | 582 | (with-rcirc-process-buffer process |
| 581 | (setq header-line-format (format "%f" (- (if (featurep 'xemacs) | 583 | (setq header-line-format (format "%f" (- (rcirc-float-time) |
| 582 | (time-to-seconds | ||
| 583 | (current-time)) | ||
| 584 | (float-time)) | ||
| 585 | (string-to-number message)))))) | 584 | (string-to-number message)))))) |
| 586 | 585 | ||
| 587 | (defvar rcirc-debug-buffer " *rcirc debug*") | 586 | (defvar rcirc-debug-buffer " *rcirc debug*") |
| @@ -2209,7 +2208,7 @@ With a prefix arg, prompt for new topic." | |||
| 2209 | 2208 | ||
| 2210 | (defun rcirc-ctcp-sender-PING (process target request) | 2209 | (defun rcirc-ctcp-sender-PING (process target request) |
| 2211 | "Send a CTCP PING message to TARGET." | 2210 | "Send a CTCP PING message to TARGET." |
| 2212 | (let ((timestamp (format "%.0f" (float-time)))) | 2211 | (let ((timestamp (format "%.0f" (rcirc-float-time)))) |
| 2213 | (rcirc-send-ctcp process target "PING" timestamp))) | 2212 | (rcirc-send-ctcp process target "PING" timestamp))) |
| 2214 | 2213 | ||
| 2215 | (defun rcirc-cmd-me (args &optional process target) | 2214 | (defun rcirc-cmd-me (args &optional process target) |
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el new file mode 100644 index 00000000000..b4307223ba8 --- /dev/null +++ b/lisp/net/soap-client.el | |||
| @@ -0,0 +1,1741 @@ | |||
| 1 | ;;;; soap-client.el -- Access SOAP web services from Emacs | ||
| 2 | |||
| 3 | ;; Copyright (C) 2009-2011 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) | ||
| 6 | ;; Created: December, 2009 | ||
| 7 | ;; Keywords: soap, web-services, comm, hypermedia | ||
| 8 | ;; Homepage: http://code.google.com/p/emacs-soap-client | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | ;; | ||
| 27 | ;; To use the SOAP client, you first need to load the WSDL document for the | ||
| 28 | ;; service you want to access, using `soap-load-wsdl-from-url'. A WSDL | ||
| 29 | ;; document describes the available operations of the SOAP service, how their | ||
| 30 | ;; parameters and responses are encoded. To invoke operations, you use the | ||
| 31 | ;; `soap-invoke' method passing it the WSDL, the service name, the operation | ||
| 32 | ;; you wish to invoke and any required parameters. | ||
| 33 | ;; | ||
| 34 | ;; Idealy, the service you want to access will have some documentation about | ||
| 35 | ;; the operations it supports. If it does not, you can try using | ||
| 36 | ;; `soap-inspect' to browse the WSDL document and see the available operations | ||
| 37 | ;; and their parameters. | ||
| 38 | ;; | ||
| 39 | |||
| 40 | ;;; Code: | ||
| 41 | |||
| 42 | (eval-when-compile (require 'cl)) | ||
| 43 | |||
| 44 | (require 'xml) | ||
| 45 | (require 'warnings) | ||
| 46 | (require 'url) | ||
| 47 | (require 'url-http) | ||
| 48 | (require 'url-util) | ||
| 49 | (require 'mm-decode) | ||
| 50 | |||
| 51 | (defsubst soap-warning (message &rest args) | ||
| 52 | "Display a warning MESSAGE with ARGS, using the 'soap-client warning type." | ||
| 53 | (display-warning 'soap-client (apply 'format message args) :warning)) | ||
| 54 | |||
| 55 | (defgroup soap-client nil | ||
| 56 | "Access SOAP web services from Emacs." | ||
| 57 | :group 'tools) | ||
| 58 | |||
| 59 | ;;;; Support for parsing XML documents with namespaces | ||
| 60 | |||
| 61 | ;; XML documents with namespaces are difficult to parse because the names of | ||
| 62 | ;; the nodes depend on what "xmlns" aliases have been defined in the document. | ||
| 63 | ;; To work with such documents, we introduce a translation layer between a | ||
| 64 | ;; "well known" namespace tag and the local namespace tag in the document | ||
| 65 | ;; being parsed. | ||
| 66 | |||
| 67 | (defconst soap-well-known-xmlns | ||
| 68 | '(("apachesoap" . "http://xml.apache.org/xml-soap") | ||
| 69 | ("soapenc" . "http://schemas.xmlsoap.org/soap/encoding/") | ||
| 70 | ("wsdl" . "http://schemas.xmlsoap.org/wsdl/") | ||
| 71 | ("wsdlsoap" . "http://schemas.xmlsoap.org/wsdl/soap/") | ||
| 72 | ("xsd" . "http://www.w3.org/2001/XMLSchema") | ||
| 73 | ("xsi" . "http://www.w3.org/2001/XMLSchema-instance") | ||
| 74 | ("soap" . "http://schemas.xmlsoap.org/soap/envelope/") | ||
| 75 | ("soap12" . "http://schemas.xmlsoap.org/wsdl/soap12/") | ||
| 76 | ("http" . "http://schemas.xmlsoap.org/wsdl/http/") | ||
| 77 | ("mime" . "http://schemas.xmlsoap.org/wsdl/mime/")) | ||
| 78 | "A list of well known xml namespaces and their aliases.") | ||
| 79 | |||
| 80 | (defvar soap-local-xmlns nil | ||
| 81 | "A list of local namespace aliases. | ||
| 82 | This is a dynamically bound variable, controlled by | ||
| 83 | `soap-with-local-xmlns'.") | ||
| 84 | |||
| 85 | (defvar soap-default-xmlns nil | ||
| 86 | "The default XML namespaces. | ||
| 87 | Names in this namespace will be unqualified. This is a | ||
| 88 | dynamically bound variable, controlled by | ||
| 89 | `soap-with-local-xmlns'") | ||
| 90 | |||
| 91 | (defvar soap-target-xmlns nil | ||
| 92 | "The target XML namespace. | ||
| 93 | New XSD elements will be defined in this namespace, unless they | ||
| 94 | are fully qualified for a different namespace. This is a | ||
| 95 | dynamically bound variable, controlled by | ||
| 96 | `soap-with-local-xmlns'") | ||
| 97 | |||
| 98 | (defun soap-wk2l (well-known-name) | ||
| 99 | "Return local variant of WELL-KNOWN-NAME. | ||
| 100 | This is done by looking up the namespace in the | ||
| 101 | `soap-well-known-xmlns' table and resolving the namespace to | ||
| 102 | the local name based on the current local translation table | ||
| 103 | `soap-local-xmlns'. See also `soap-with-local-xmlns'." | ||
| 104 | (let ((wk-name-1 (if (symbolp well-known-name) | ||
| 105 | (symbol-name well-known-name) | ||
| 106 | well-known-name))) | ||
| 107 | (cond | ||
| 108 | ((string-match "^\\(.*\\):\\(.*\\)$" wk-name-1) | ||
| 109 | (let ((ns (match-string 1 wk-name-1)) | ||
| 110 | (name (match-string 2 wk-name-1))) | ||
| 111 | (let ((namespace (cdr (assoc ns soap-well-known-xmlns)))) | ||
| 112 | (cond ((equal namespace soap-default-xmlns) | ||
| 113 | ;; Name is unqualified in the default namespace | ||
| 114 | (if (symbolp well-known-name) | ||
| 115 | (intern name) | ||
| 116 | name)) | ||
| 117 | (t | ||
| 118 | (let* ((local-ns (car (rassoc namespace soap-local-xmlns))) | ||
| 119 | (local-name (concat local-ns ":" name))) | ||
| 120 | (if (symbolp well-known-name) | ||
| 121 | (intern local-name) | ||
| 122 | local-name))))))) | ||
| 123 | (t well-known-name)))) | ||
| 124 | |||
| 125 | (defun soap-l2wk (local-name) | ||
| 126 | "Convert LOCAL-NAME into a well known name. | ||
| 127 | The namespace of LOCAL-NAME is looked up in the | ||
| 128 | `soap-well-known-xmlns' table and a well known namespace tag is | ||
| 129 | used in the name. | ||
| 130 | |||
| 131 | nil is returned if there is no well-known namespace for the | ||
| 132 | namespace of LOCAL-NAME." | ||
| 133 | (let ((l-name-1 (if (symbolp local-name) | ||
| 134 | (symbol-name local-name) | ||
| 135 | local-name)) | ||
| 136 | namespace name) | ||
| 137 | (cond | ||
| 138 | ((string-match "^\\(.*\\):\\(.*\\)$" l-name-1) | ||
| 139 | (setq name (match-string 2 l-name-1)) | ||
| 140 | (let ((ns (match-string 1 l-name-1))) | ||
| 141 | (setq namespace (cdr (assoc ns soap-local-xmlns))) | ||
| 142 | (unless namespace | ||
| 143 | (error "Soap-l2wk(%s): no namespace for alias %s" local-name ns)))) | ||
| 144 | (t | ||
| 145 | (setq name l-name-1) | ||
| 146 | (setq namespace soap-default-xmlns))) | ||
| 147 | |||
| 148 | (if namespace | ||
| 149 | (let ((well-known-ns (car (rassoc namespace soap-well-known-xmlns)))) | ||
| 150 | (if well-known-ns | ||
| 151 | (let ((well-known-name (concat well-known-ns ":" name))) | ||
| 152 | (if (symbol-name local-name) | ||
| 153 | (intern well-known-name) | ||
| 154 | well-known-name)) | ||
| 155 | (progn | ||
| 156 | ;; (soap-warning "soap-l2wk(%s): namespace %s has no well-known tag" | ||
| 157 | ;; local-name namespace) | ||
| 158 | nil))) | ||
| 159 | ;; if no namespace is defined, just return the unqualified name | ||
| 160 | name))) | ||
| 161 | |||
| 162 | |||
| 163 | (defun soap-l2fq (local-name &optional use-tns) | ||
| 164 | "Convert LOCAL-NAME into a fully qualified name. | ||
| 165 | A fully qualified name is a cons of the namespace name and the | ||
| 166 | name of the element itself. For example \"xsd:string\" is | ||
| 167 | converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\"\). | ||
| 168 | |||
| 169 | The USE-TNS argument specifies what to do when LOCAL-NAME has no | ||
| 170 | namespace tag. If USE-TNS is non-nil, the `soap-target-xmlns' | ||
| 171 | will be used as the element's namespace, otherwise | ||
| 172 | `soap-default-xmlns' will be used. | ||
| 173 | |||
| 174 | This is needed because different parts of a WSDL document can use | ||
| 175 | different namespace aliases for the same element." | ||
| 176 | (let ((local-name-1 (if (symbolp local-name) | ||
| 177 | (symbol-name local-name) | ||
| 178 | local-name))) | ||
| 179 | (cond ((string-match "^\\(.*\\):\\(.*\\)$" local-name-1) | ||
| 180 | (let ((ns (match-string 1 local-name-1)) | ||
| 181 | (name (match-string 2 local-name-1))) | ||
| 182 | (let ((namespace (cdr (assoc ns soap-local-xmlns)))) | ||
| 183 | (if namespace | ||
| 184 | (cons namespace name) | ||
| 185 | (error "Soap-l2fq(%s): unknown alias %s" local-name ns))))) | ||
| 186 | (t | ||
| 187 | (cons (if use-tns | ||
| 188 | soap-target-xmlns | ||
| 189 | soap-default-xmlns) | ||
| 190 | local-name))))) | ||
| 191 | |||
| 192 | (defun soap-extract-xmlns (node &optional xmlns-table) | ||
| 193 | "Return a namespace alias table for NODE by extending XMLNS-TABLE." | ||
| 194 | (let (xmlns default-ns target-ns) | ||
| 195 | (dolist (a (xml-node-attributes node)) | ||
| 196 | (let ((name (symbol-name (car a))) | ||
| 197 | (value (cdr a))) | ||
| 198 | (cond ((string= name "targetNamespace") | ||
| 199 | (setq target-ns value)) | ||
| 200 | ((string= name "xmlns") | ||
| 201 | (setq default-ns value)) | ||
| 202 | ((string-match "^xmlns:\\(.*\\)$" name) | ||
| 203 | (push (cons (match-string 1 name) value) xmlns))))) | ||
| 204 | |||
| 205 | (let ((tns (assoc "tns" xmlns))) | ||
| 206 | (cond ((and tns target-ns) | ||
| 207 | ;; If a tns alias is defined for this node, it must match | ||
| 208 | ;; the target namespace. | ||
| 209 | (unless (equal target-ns (cdr tns)) | ||
| 210 | (soap-warning | ||
| 211 | "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch" | ||
| 212 | (xml-node-name node)))) | ||
| 213 | ((and tns (not target-ns)) | ||
| 214 | (setq target-ns (cdr tns))) | ||
| 215 | ((and (not tns) target-ns) | ||
| 216 | ;; a tns alias was not defined in this node. See if the node has | ||
| 217 | ;; a "targetNamespace" attribute and add an alias to this. Note | ||
| 218 | ;; that we might override an existing tns alias in XMLNS-TABLE, | ||
| 219 | ;; but that is intended. | ||
| 220 | (push (cons "tns" target-ns) xmlns)))) | ||
| 221 | |||
| 222 | (list default-ns target-ns (append xmlns xmlns-table)))) | ||
| 223 | |||
| 224 | (defmacro soap-with-local-xmlns (node &rest body) | ||
| 225 | "Install a local alias table from NODE and execute BODY." | ||
| 226 | (declare (debug (form &rest form)) (indent 1)) | ||
| 227 | (let ((xmlns (make-symbol "xmlns"))) | ||
| 228 | `(let ((,xmlns (soap-extract-xmlns ,node soap-local-xmlns))) | ||
| 229 | (let ((soap-default-xmlns (or (nth 0 ,xmlns) soap-default-xmlns)) | ||
| 230 | (soap-target-xmlns (or (nth 1 ,xmlns) soap-target-xmlns)) | ||
| 231 | (soap-local-xmlns (nth 2 ,xmlns))) | ||
| 232 | ,@body)))) | ||
| 233 | |||
| 234 | (defun soap-get-target-namespace (node) | ||
| 235 | "Return the target namespace of NODE. | ||
| 236 | This is the namespace in which new elements will be defined." | ||
| 237 | (or (xml-get-attribute-or-nil node 'targetNamespace) | ||
| 238 | (cdr (assoc "tns" soap-local-xmlns)) | ||
| 239 | soap-target-xmlns)) | ||
| 240 | |||
| 241 | (defun soap-xml-get-children1 (node child-name) | ||
| 242 | "Return the children of NODE named CHILD-NAME. | ||
| 243 | This is the same as `xml-get-children', but CHILD-NAME can have | ||
| 244 | namespace tag." | ||
| 245 | (let (result) | ||
| 246 | (dolist (c (xml-node-children node)) | ||
| 247 | (when (and (consp c) | ||
| 248 | (soap-with-local-xmlns c | ||
| 249 | ;; We use `ignore-errors' here because we want to silently | ||
| 250 | ;; skip nodes for which we cannot convert them to a | ||
| 251 | ;; well-known name. | ||
| 252 | (eq (ignore-errors (soap-l2wk (xml-node-name c))) | ||
| 253 | child-name))) | ||
| 254 | (push c result))) | ||
| 255 | (nreverse result))) | ||
| 256 | |||
| 257 | (defun soap-xml-get-attribute-or-nil1 (node attribute) | ||
| 258 | "Return the NODE's ATTRIBUTE, or nil if it does not exist. | ||
| 259 | This is the same as `xml-get-attribute-or-nil', but ATTRIBUTE can | ||
| 260 | be tagged with a namespace tag." | ||
| 261 | (catch 'found | ||
| 262 | (soap-with-local-xmlns node | ||
| 263 | (dolist (a (xml-node-attributes node)) | ||
| 264 | ;; We use `ignore-errors' here because we want to silently skip | ||
| 265 | ;; attributes for which we cannot convert them to a well-known name. | ||
| 266 | (when (eq (ignore-errors (soap-l2wk (car a))) attribute) | ||
| 267 | (throw 'found (cdr a))))))) | ||
| 268 | |||
| 269 | |||
| 270 | ;;;; XML namespaces | ||
| 271 | |||
| 272 | ;; An element in an XML namespace, "things" stored in soap-xml-namespaces will | ||
| 273 | ;; be derived from this object. | ||
| 274 | |||
| 275 | (defstruct soap-element | ||
| 276 | name | ||
| 277 | ;; The "well-known" namespace tag for the element. For example, while | ||
| 278 | ;; parsing XML documents, we can have different tags for the XMLSchema | ||
| 279 | ;; namespace, but internally all our XMLSchema elements will have the "xsd" | ||
| 280 | ;; tag. | ||
| 281 | namespace-tag) | ||
| 282 | |||
| 283 | (defun soap-element-fq-name (element) | ||
| 284 | "Return a fully qualified name for ELEMENT. | ||
| 285 | A fq name is the concatenation of the namespace tag and the | ||
| 286 | element name." | ||
| 287 | (concat (soap-element-namespace-tag element) | ||
| 288 | ":" (soap-element-name element))) | ||
| 289 | |||
| 290 | ;; a namespace link stores an alias for an object in once namespace to a | ||
| 291 | ;; "target" object possibly in a different namespace | ||
| 292 | |||
| 293 | (defstruct (soap-namespace-link (:include soap-element)) | ||
| 294 | target) | ||
| 295 | |||
| 296 | ;; A namespace is a collection of soap-element objects under a name (the name | ||
| 297 | ;; of the namespace). | ||
| 298 | |||
| 299 | (defstruct soap-namespace | ||
| 300 | (name nil :read-only t) ; e.g "http://xml.apache.org/xml-soap" | ||
| 301 | (elements (make-hash-table :test 'equal) :read-only t)) | ||
| 302 | |||
| 303 | (defun soap-namespace-put (element ns) | ||
| 304 | "Store ELEMENT in NS. | ||
| 305 | Multiple elements with the same name can be stored in a | ||
| 306 | namespace. When retrieving the element you can specify a | ||
| 307 | discriminant predicate to `soap-namespace-get'" | ||
| 308 | (let ((name (soap-element-name element))) | ||
| 309 | (push element (gethash name (soap-namespace-elements ns))))) | ||
| 310 | |||
| 311 | (defun soap-namespace-put-link (name target ns &optional replace) | ||
| 312 | "Store a link from NAME to TARGET in NS. | ||
| 313 | An error will be signaled if an element by the same name is | ||
| 314 | already present in NS, unless REPLACE is non nil. | ||
| 315 | |||
| 316 | TARGET can be either a SOAP-ELEMENT or a string denoting an | ||
| 317 | element name into another namespace. | ||
| 318 | |||
| 319 | If NAME is nil, an element with the same name as TARGET will be | ||
| 320 | added to the namespace." | ||
| 321 | |||
| 322 | (unless (and name (not (equal name ""))) | ||
| 323 | ;; if name is nil, use TARGET as a name... | ||
| 324 | (cond ((soap-element-p target) | ||
| 325 | (setq name (soap-element-name target))) | ||
| 326 | ((stringp target) | ||
| 327 | (cond ((string-match "^\\(.*\\):\\(.*\\)$" target) | ||
| 328 | (setq name (match-string 2 target))) | ||
| 329 | (t | ||
| 330 | (setq name target)))))) | ||
| 331 | |||
| 332 | (assert name) ; by now, name should be valid | ||
| 333 | (push (make-soap-namespace-link :name name :target target) | ||
| 334 | (gethash name (soap-namespace-elements ns)))) | ||
| 335 | |||
| 336 | (defun soap-namespace-get (name ns &optional discriminant-predicate) | ||
| 337 | "Retrieve an element with NAME from the namespace NS. | ||
| 338 | If multiple elements with the same name exist, | ||
| 339 | DISCRIMINANT-PREDICATE is used to pick one of them. This allows | ||
| 340 | storing elements of different types (like a message type and a | ||
| 341 | binding) but the same name." | ||
| 342 | (assert (stringp name)) | ||
| 343 | (let ((elements (gethash name (soap-namespace-elements ns)))) | ||
| 344 | (cond (discriminant-predicate | ||
| 345 | (catch 'found | ||
| 346 | (dolist (e elements) | ||
| 347 | (when (funcall discriminant-predicate e) | ||
| 348 | (throw 'found e))))) | ||
| 349 | ((= (length elements) 1) (car elements)) | ||
| 350 | ((> (length elements) 1) | ||
| 351 | (error | ||
| 352 | "Soap-namespace-get(%s): multiple elements, discriminant needed" | ||
| 353 | name)) | ||
| 354 | (t | ||
| 355 | nil)))) | ||
| 356 | |||
| 357 | |||
| 358 | ;;;; WSDL documents | ||
| 359 | ;;;;; WSDL document elements | ||
| 360 | |||
| 361 | (defstruct (soap-basic-type (:include soap-element)) | ||
| 362 | kind ; a symbol of: string, dateTime, long, int | ||
| 363 | ) | ||
| 364 | |||
| 365 | (defstruct soap-sequence-element | ||
| 366 | name type nillable? multiple?) | ||
| 367 | |||
| 368 | (defstruct (soap-sequence-type (:include soap-element)) | ||
| 369 | parent ; OPTIONAL WSDL-TYPE name | ||
| 370 | elements ; LIST of SOAP-SEQUCENCE-ELEMENT | ||
| 371 | ) | ||
| 372 | |||
| 373 | (defstruct (soap-array-type (:include soap-element)) | ||
| 374 | element-type ; WSDL-TYPE of the array elements | ||
| 375 | ) | ||
| 376 | |||
| 377 | (defstruct (soap-message (:include soap-element)) | ||
| 378 | parts ; ALIST of NAME => WSDL-TYPE name | ||
| 379 | ) | ||
| 380 | |||
| 381 | (defstruct (soap-operation (:include soap-element)) | ||
| 382 | parameter-order | ||
| 383 | input ; (NAME . MESSAGE) | ||
| 384 | output ; (NAME . MESSAGE) | ||
| 385 | faults) ; a list of (NAME . MESSAGE) | ||
| 386 | |||
| 387 | (defstruct (soap-port-type (:include soap-element)) | ||
| 388 | operations) ; a namespace of operations | ||
| 389 | |||
| 390 | ;; A bound operation is an operation which has a soap action and a use | ||
| 391 | ;; method attached -- these are attached as part of a binding and we | ||
| 392 | ;; can have different bindings for the same operations. | ||
| 393 | (defstruct soap-bound-operation | ||
| 394 | operation ; SOAP-OPERATION | ||
| 395 | soap-action ; value for SOAPAction HTTP header | ||
| 396 | use ; 'literal or 'encoded, see | ||
| 397 | ; http://www.w3.org/TR/wsdl#_soap:body | ||
| 398 | ) | ||
| 399 | |||
| 400 | (defstruct (soap-binding (:include soap-element)) | ||
| 401 | port-type | ||
| 402 | (operations (make-hash-table :test 'equal) :readonly t)) | ||
| 403 | |||
| 404 | (defstruct (soap-port (:include soap-element)) | ||
| 405 | service-url | ||
| 406 | binding) | ||
| 407 | |||
| 408 | (defun soap-default-xsd-types () | ||
| 409 | "Return a namespace containing some of the XMLSchema types." | ||
| 410 | (let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema"))) | ||
| 411 | (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" | ||
| 412 | "base64Binary" "anyType" "Array" "byte[]")) | ||
| 413 | (soap-namespace-put | ||
| 414 | (make-soap-basic-type :name type :kind (intern type)) | ||
| 415 | ns)) | ||
| 416 | ns)) | ||
| 417 | |||
| 418 | (defun soap-default-soapenc-types () | ||
| 419 | "Return a namespace containing some of the SOAPEnc types." | ||
| 420 | (let ((ns (make-soap-namespace | ||
| 421 | :name "http://schemas.xmlsoap.org/soap/encoding/"))) | ||
| 422 | (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" | ||
| 423 | "base64Binary" "anyType" "Array" "byte[]")) | ||
| 424 | (soap-namespace-put | ||
| 425 | (make-soap-basic-type :name type :kind (intern type)) | ||
| 426 | ns)) | ||
| 427 | ns)) | ||
| 428 | |||
| 429 | (defun soap-type-p (element) | ||
| 430 | "Return t if ELEMENT is a SOAP data type (basic or complex)." | ||
| 431 | (or (soap-basic-type-p element) | ||
| 432 | (soap-sequence-type-p element) | ||
| 433 | (soap-array-type-p element))) | ||
| 434 | |||
| 435 | |||
| 436 | ;;;;; The WSDL document | ||
| 437 | |||
| 438 | ;; The WSDL data structure used for encoding/decoding SOAP messages | ||
| 439 | (defstruct soap-wsdl | ||
| 440 | origin ; file or URL from which this wsdl was loaded | ||
| 441 | ports ; a list of SOAP-PORT instances | ||
| 442 | alias-table ; a list of namespace aliases | ||
| 443 | namespaces ; a list of namespaces | ||
| 444 | ) | ||
| 445 | |||
| 446 | (defun soap-wsdl-add-alias (alias name wsdl) | ||
| 447 | "Add a namespace ALIAS for NAME to the WSDL document." | ||
| 448 | (push (cons alias name) (soap-wsdl-alias-table wsdl))) | ||
| 449 | |||
| 450 | (defun soap-wsdl-find-namespace (name wsdl) | ||
| 451 | "Find a namespace by NAME in the WSDL document." | ||
| 452 | (catch 'found | ||
| 453 | (dolist (ns (soap-wsdl-namespaces wsdl)) | ||
| 454 | (when (equal name (soap-namespace-name ns)) | ||
| 455 | (throw 'found ns))))) | ||
| 456 | |||
| 457 | (defun soap-wsdl-add-namespace (ns wsdl) | ||
| 458 | "Add the namespace NS to the WSDL document. | ||
| 459 | If a namespace by this name already exists in WSDL, individual | ||
| 460 | elements will be added to it." | ||
| 461 | (let ((existing (soap-wsdl-find-namespace (soap-namespace-name ns) wsdl))) | ||
| 462 | (if existing | ||
| 463 | ;; Add elements from NS to EXISTING, replacing existing values. | ||
| 464 | (maphash (lambda (key value) | ||
| 465 | (dolist (v value) | ||
| 466 | (soap-namespace-put v existing))) | ||
| 467 | (soap-namespace-elements ns)) | ||
| 468 | (push ns (soap-wsdl-namespaces wsdl))))) | ||
| 469 | |||
| 470 | (defun soap-wsdl-get (name wsdl &optional predicate use-local-alias-table) | ||
| 471 | "Retrieve element NAME from the WSDL document. | ||
| 472 | |||
| 473 | PREDICATE is used to differentiate between elements when NAME | ||
| 474 | refers to multiple elements. A typical value for this would be a | ||
| 475 | structure predicate for the type of element you want to retrieve. | ||
| 476 | For example, to retrieve a message named \"foo\" when other | ||
| 477 | elements named \"foo\" exist in the WSDL you could use: | ||
| 478 | |||
| 479 | (soap-wsdl-get \"foo\" WSDL 'soap-message-p) | ||
| 480 | |||
| 481 | If USE-LOCAL-ALIAS-TABLE is not nil, `soap-local-xmlns` will be | ||
| 482 | used to resolve the namespace alias." | ||
| 483 | (let ((alias-table (soap-wsdl-alias-table wsdl)) | ||
| 484 | namespace element-name element) | ||
| 485 | |||
| 486 | (when (symbolp name) | ||
| 487 | (setq name (symbol-name name))) | ||
| 488 | |||
| 489 | (when use-local-alias-table | ||
| 490 | (setq alias-table (append soap-local-xmlns alias-table))) | ||
| 491 | |||
| 492 | (cond ((consp name) ; a fully qualified name, as returned by `soap-l2fq' | ||
| 493 | (setq element-name (cdr name)) | ||
| 494 | (when (symbolp element-name) | ||
| 495 | (setq element-name (symbol-name element-name))) | ||
| 496 | (setq namespace (soap-wsdl-find-namespace (car name) wsdl)) | ||
| 497 | (unless namespace | ||
| 498 | (error "Soap-wsdl-get(%s): unknown namespace: %s" name namespace))) | ||
| 499 | |||
| 500 | ((string-match "^\\(.*\\):\\(.*\\)$" name) | ||
| 501 | (setq element-name (match-string 2 name)) | ||
| 502 | |||
| 503 | (let* ((ns-alias (match-string 1 name)) | ||
| 504 | (ns-name (cdr (assoc ns-alias alias-table)))) | ||
| 505 | (unless ns-name | ||
| 506 | (error "Soap-wsdl-get(%s): cannot find namespace alias %s" | ||
| 507 | name ns-alias)) | ||
| 508 | |||
| 509 | (setq namespace (soap-wsdl-find-namespace ns-name wsdl)) | ||
| 510 | (unless namespace | ||
| 511 | (error | ||
| 512 | "Soap-wsdl-get(%s): unknown namespace %s, referenced by alias %s" | ||
| 513 | name ns-name ns-alias)))) | ||
| 514 | (t | ||
| 515 | (error "Soap-wsdl-get(%s): bad name" name))) | ||
| 516 | |||
| 517 | (setq element (soap-namespace-get | ||
| 518 | element-name namespace | ||
| 519 | (if predicate | ||
| 520 | (lambda (e) | ||
| 521 | (or (funcall 'soap-namespace-link-p e) | ||
| 522 | (funcall predicate e))) | ||
| 523 | nil))) | ||
| 524 | |||
| 525 | (unless element | ||
| 526 | (error "Soap-wsdl-get(%s): cannot find element" name)) | ||
| 527 | |||
| 528 | (if (soap-namespace-link-p element) | ||
| 529 | ;; NOTE: don't use the local alias table here | ||
| 530 | (soap-wsdl-get (soap-namespace-link-target element) wsdl predicate) | ||
| 531 | element))) | ||
| 532 | |||
| 533 | ;;;;; Resolving references for wsdl types | ||
| 534 | |||
| 535 | ;; See `soap-wsdl-resolve-references', which is the main entry point for | ||
| 536 | ;; resolving references | ||
| 537 | |||
| 538 | (defun soap-resolve-references-for-element (element wsdl) | ||
| 539 | "Resolve references in ELEMENT using the WSDL document. | ||
| 540 | This is a generic function which invokes a specific function | ||
| 541 | depending on the element type. | ||
| 542 | |||
| 543 | If ELEMENT has no resolver function, it is silently ignored. | ||
| 544 | |||
| 545 | All references are resolved in-place, that is the ELEMENT is | ||
| 546 | updated." | ||
| 547 | (let ((resolver (get (aref element 0) 'soap-resolve-references))) | ||
| 548 | (when resolver | ||
| 549 | (funcall resolver element wsdl)))) | ||
| 550 | |||
| 551 | (defun soap-resolve-references-for-sequence-type (type wsdl) | ||
| 552 | "Resolve references for a sequence TYPE using WSDL document. | ||
| 553 | See also `soap-resolve-references-for-element' and | ||
| 554 | `soap-wsdl-resolve-references'" | ||
| 555 | (let ((parent (soap-sequence-type-parent type))) | ||
| 556 | (when (or (consp parent) (stringp parent)) | ||
| 557 | (setf (soap-sequence-type-parent type) | ||
| 558 | (soap-wsdl-get parent wsdl 'soap-type-p)))) | ||
| 559 | (dolist (element (soap-sequence-type-elements type)) | ||
| 560 | (let ((element-type (soap-sequence-element-type element))) | ||
| 561 | (cond ((or (consp element-type) (stringp element-type)) | ||
| 562 | (setf (soap-sequence-element-type element) | ||
| 563 | (soap-wsdl-get element-type wsdl 'soap-type-p))) | ||
| 564 | ((soap-element-p element-type) | ||
| 565 | ;; since the element already has a child element, it | ||
| 566 | ;; could be an inline structure. we must resolve | ||
| 567 | ;; references in it, because it might not be reached by | ||
| 568 | ;; scanning the wsdl names. | ||
| 569 | (soap-resolve-references-for-element element-type wsdl)))))) | ||
| 570 | |||
| 571 | (defun soap-resolve-references-for-array-type (type wsdl) | ||
| 572 | "Resolve references for an array TYPE using WSDL. | ||
| 573 | See also `soap-resolve-references-for-element' and | ||
| 574 | `soap-wsdl-resolve-references'" | ||
| 575 | (let ((element-type (soap-array-type-element-type type))) | ||
| 576 | (when (or (consp element-type) (stringp element-type)) | ||
| 577 | (setf (soap-array-type-element-type type) | ||
| 578 | (soap-wsdl-get element-type wsdl 'soap-type-p))))) | ||
| 579 | |||
| 580 | (defun soap-resolve-references-for-message (message wsdl) | ||
| 581 | "Resolve references for a MESSAGE type using the WSDL document. | ||
| 582 | See also `soap-resolve-references-for-element' and | ||
| 583 | `soap-wsdl-resolve-references'" | ||
| 584 | (let (resolved-parts) | ||
| 585 | (dolist (part (soap-message-parts message)) | ||
| 586 | (let ((name (car part)) | ||
| 587 | (type (cdr part))) | ||
| 588 | (when (stringp name) | ||
| 589 | (setq name (intern name))) | ||
| 590 | (when (or (consp type) (stringp type)) | ||
| 591 | (setq type (soap-wsdl-get type wsdl 'soap-type-p))) | ||
| 592 | (push (cons name type) resolved-parts))) | ||
| 593 | (setf (soap-message-parts message) (nreverse resolved-parts)))) | ||
| 594 | |||
| 595 | (defun soap-resolve-references-for-operation (operation wsdl) | ||
| 596 | "Resolve references for an OPERATION type using the WSDL document. | ||
| 597 | See also `soap-resolve-references-for-element' and | ||
| 598 | `soap-wsdl-resolve-references'" | ||
| 599 | (let ((input (soap-operation-input operation)) | ||
| 600 | (counter 0)) | ||
| 601 | (let ((name (car input)) | ||
| 602 | (message (cdr input))) | ||
| 603 | ;; Name this part if it was not named | ||
| 604 | (when (or (null name) (equal name "")) | ||
| 605 | (setq name (format "in%d" (incf counter)))) | ||
| 606 | (when (or (consp message) (stringp message)) | ||
| 607 | (setf (soap-operation-input operation) | ||
| 608 | (cons (intern name) | ||
| 609 | (soap-wsdl-get message wsdl 'soap-message-p)))))) | ||
| 610 | |||
| 611 | (let ((output (soap-operation-output operation)) | ||
| 612 | (counter 0)) | ||
| 613 | (let ((name (car output)) | ||
| 614 | (message (cdr output))) | ||
| 615 | (when (or (null name) (equal name "")) | ||
| 616 | (setq name (format "out%d" (incf counter)))) | ||
| 617 | (when (or (consp message) (stringp message)) | ||
| 618 | (setf (soap-operation-output operation) | ||
| 619 | (cons (intern name) | ||
| 620 | (soap-wsdl-get message wsdl 'soap-message-p)))))) | ||
| 621 | |||
| 622 | (let ((resolved-faults nil) | ||
| 623 | (counter 0)) | ||
| 624 | (dolist (fault (soap-operation-faults operation)) | ||
| 625 | (let ((name (car fault)) | ||
| 626 | (message (cdr fault))) | ||
| 627 | (when (or (null name) (equal name "")) | ||
| 628 | (setq name (format "fault%d" (incf counter)))) | ||
| 629 | (if (or (consp message) (stringp message)) | ||
| 630 | (push (cons (intern name) | ||
| 631 | (soap-wsdl-get message wsdl 'soap-message-p)) | ||
| 632 | resolved-faults) | ||
| 633 | (push fault resolved-faults)))) | ||
| 634 | (setf (soap-operation-faults operation) resolved-faults)) | ||
| 635 | |||
| 636 | (when (= (length (soap-operation-parameter-order operation)) 0) | ||
| 637 | (setf (soap-operation-parameter-order operation) | ||
| 638 | (mapcar 'car (soap-message-parts | ||
| 639 | (cdr (soap-operation-input operation)))))) | ||
| 640 | |||
| 641 | (setf (soap-operation-parameter-order operation) | ||
| 642 | (mapcar (lambda (p) | ||
| 643 | (if (stringp p) | ||
| 644 | (intern p) | ||
| 645 | p)) | ||
| 646 | (soap-operation-parameter-order operation)))) | ||
| 647 | |||
| 648 | (defun soap-resolve-references-for-binding (binding wsdl) | ||
| 649 | "Resolve references for a BINDING type using the WSDL document. | ||
| 650 | See also `soap-resolve-references-for-element' and | ||
| 651 | `soap-wsdl-resolve-references'" | ||
| 652 | (when (or (consp (soap-binding-port-type binding)) | ||
| 653 | (stringp (soap-binding-port-type binding))) | ||
| 654 | (setf (soap-binding-port-type binding) | ||
| 655 | (soap-wsdl-get (soap-binding-port-type binding) | ||
| 656 | wsdl 'soap-port-type-p))) | ||
| 657 | |||
| 658 | (let ((port-ops (soap-port-type-operations (soap-binding-port-type binding)))) | ||
| 659 | (maphash (lambda (k v) | ||
| 660 | (setf (soap-bound-operation-operation v) | ||
| 661 | (soap-namespace-get k port-ops 'soap-operation-p))) | ||
| 662 | (soap-binding-operations binding)))) | ||
| 663 | |||
| 664 | (defun soap-resolve-references-for-port (port wsdl) | ||
| 665 | "Resolve references for a PORT type using the WSDL document. | ||
| 666 | See also `soap-resolve-references-for-element' and | ||
| 667 | `soap-wsdl-resolve-references'" | ||
| 668 | (when (or (consp (soap-port-binding port)) | ||
| 669 | (stringp (soap-port-binding port))) | ||
| 670 | (setf (soap-port-binding port) | ||
| 671 | (soap-wsdl-get (soap-port-binding port) wsdl 'soap-binding-p)))) | ||
| 672 | |||
| 673 | ;; Install resolvers for our types | ||
| 674 | (progn | ||
| 675 | (put (aref (make-soap-sequence-type) 0) 'soap-resolve-references | ||
| 676 | 'soap-resolve-references-for-sequence-type) | ||
| 677 | (put (aref (make-soap-array-type) 0) 'soap-resolve-references | ||
| 678 | 'soap-resolve-references-for-array-type) | ||
| 679 | (put (aref (make-soap-message) 0) 'soap-resolve-references | ||
| 680 | 'soap-resolve-references-for-message) | ||
| 681 | (put (aref (make-soap-operation) 0) 'soap-resolve-references | ||
| 682 | 'soap-resolve-references-for-operation) | ||
| 683 | (put (aref (make-soap-binding) 0) 'soap-resolve-references | ||
| 684 | 'soap-resolve-references-for-binding) | ||
| 685 | (put (aref (make-soap-port) 0) 'soap-resolve-references | ||
| 686 | 'soap-resolve-references-for-port)) | ||
| 687 | |||
| 688 | (defun soap-wsdl-resolve-references (wsdl) | ||
| 689 | "Resolve all references inside the WSDL structure. | ||
| 690 | |||
| 691 | When the WSDL elements are created from the XML document, they | ||
| 692 | refer to each other by name. For example, the ELEMENT-TYPE slot | ||
| 693 | of an SOAP-ARRAY-TYPE will contain the name of the element and | ||
| 694 | the user would have to call `soap-wsdl-get' to obtain the actual | ||
| 695 | element. | ||
| 696 | |||
| 697 | After the entire document is loaded, we resolve all these | ||
| 698 | references to the actual elements they refer to so that at | ||
| 699 | runtime, we don't have to call `soap-wsdl-get' each time we | ||
| 700 | traverse an element tree." | ||
| 701 | (let ((nprocessed 0) | ||
| 702 | (nstag-id 0) | ||
| 703 | (alias-table (soap-wsdl-alias-table wsdl))) | ||
| 704 | (dolist (ns (soap-wsdl-namespaces wsdl)) | ||
| 705 | (let ((nstag (car-safe (rassoc (soap-namespace-name ns) alias-table)))) | ||
| 706 | (unless nstag | ||
| 707 | ;; If this namespace does not have an alias, create one for it. | ||
| 708 | (catch 'done | ||
| 709 | (while t | ||
| 710 | (setq nstag (format "ns%d" (incf nstag-id))) | ||
| 711 | (unless (assoc nstag alias-table) | ||
| 712 | (soap-wsdl-add-alias nstag (soap-namespace-name ns) wsdl) | ||
| 713 | (throw 'done t))))) | ||
| 714 | |||
| 715 | (maphash (lambda (name element) | ||
| 716 | (cond ((soap-element-p element) ; skip links | ||
| 717 | (incf nprocessed) | ||
| 718 | (soap-resolve-references-for-element element wsdl) | ||
| 719 | (setf (soap-element-namespace-tag element) nstag)) | ||
| 720 | ((listp element) | ||
| 721 | (dolist (e element) | ||
| 722 | (when (soap-element-p e) | ||
| 723 | (incf nprocessed) | ||
| 724 | (soap-resolve-references-for-element e wsdl) | ||
| 725 | (setf (soap-element-namespace-tag e) nstag)))))) | ||
| 726 | (soap-namespace-elements ns)))) | ||
| 727 | |||
| 728 | (message "Processed %d" nprocessed)) | ||
| 729 | wsdl) | ||
| 730 | |||
| 731 | ;;;;; Loading WSDL from XML documents | ||
| 732 | |||
| 733 | (defun soap-load-wsdl-from-url (url) | ||
| 734 | "Load a WSDL document from URL and return it. | ||
| 735 | The returned WSDL document needs to be used for `soap-invoke' | ||
| 736 | calls." | ||
| 737 | (let ((url-request-method "GET") | ||
| 738 | (url-package-name "soap-client.el") | ||
| 739 | (url-package-version "1.0") | ||
| 740 | (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") | ||
| 741 | (url-request-coding-system 'utf-8) | ||
| 742 | (url-http-attempt-keepalives nil)) | ||
| 743 | (let ((buffer (url-retrieve-synchronously url))) | ||
| 744 | (with-current-buffer buffer | ||
| 745 | (declare (special url-http-response-status)) | ||
| 746 | (if (> url-http-response-status 299) | ||
| 747 | (error "Error retrieving WSDL: %s" url-http-response-status)) | ||
| 748 | (let ((mime-part (mm-dissect-buffer t t))) | ||
| 749 | (unless mime-part | ||
| 750 | (error "Failed to decode response from server")) | ||
| 751 | (unless (equal (car (mm-handle-type mime-part)) "text/xml") | ||
| 752 | (error "Server response is not an XML document")) | ||
| 753 | (with-temp-buffer | ||
| 754 | (mm-insert-part mime-part) | ||
| 755 | (let ((wsdl-xml (car (xml-parse-region (point-min) (point-max))))) | ||
| 756 | (prog1 | ||
| 757 | (let ((wsdl (soap-parse-wsdl wsdl-xml))) | ||
| 758 | (setf (soap-wsdl-origin wsdl) url) | ||
| 759 | wsdl) | ||
| 760 | (kill-buffer buffer))))))))) | ||
| 761 | |||
| 762 | (defun soap-load-wsdl (file) | ||
| 763 | "Load a WSDL document from FILE and return it." | ||
| 764 | (with-temp-buffer | ||
| 765 | (insert-file-contents file) | ||
| 766 | (let ((xml (car (xml-parse-region (point-min) (point-max))))) | ||
| 767 | (let ((wsdl (soap-parse-wsdl xml))) | ||
| 768 | (setf (soap-wsdl-origin wsdl) file) | ||
| 769 | wsdl)))) | ||
| 770 | |||
| 771 | (defun soap-parse-wsdl (node) | ||
| 772 | "Construct a WSDL structure from NODE, which is an XML document." | ||
| 773 | (soap-with-local-xmlns node | ||
| 774 | |||
| 775 | (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:definitions) | ||
| 776 | nil | ||
| 777 | "soap-parse-wsdl: expecting wsdl:definitions node, got %s" | ||
| 778 | (soap-l2wk (xml-node-name node))) | ||
| 779 | |||
| 780 | (let ((wsdl (make-soap-wsdl))) | ||
| 781 | |||
| 782 | ;; Add the local alias table to the wsdl document -- it will be used for | ||
| 783 | ;; all types in this document even after we finish parsing it. | ||
| 784 | (setf (soap-wsdl-alias-table wsdl) soap-local-xmlns) | ||
| 785 | |||
| 786 | ;; Add the XSD types to the wsdl document | ||
| 787 | (let ((ns (soap-default-xsd-types))) | ||
| 788 | (soap-wsdl-add-namespace ns wsdl) | ||
| 789 | (soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl)) | ||
| 790 | |||
| 791 | ;; Add the soapenc types to the wsdl document | ||
| 792 | (let ((ns (soap-default-soapenc-types))) | ||
| 793 | (soap-wsdl-add-namespace ns wsdl) | ||
| 794 | (soap-wsdl-add-alias "soapenc" (soap-namespace-name ns) wsdl)) | ||
| 795 | |||
| 796 | ;; Find all the 'xsd:schema nodes which are children of wsdl:types nodes | ||
| 797 | ;; and build our type-library | ||
| 798 | |||
| 799 | (let ((types (car (soap-xml-get-children1 node 'wsdl:types)))) | ||
| 800 | (dolist (node (xml-node-children types)) | ||
| 801 | ;; We cannot use (xml-get-children node (soap-wk2l 'xsd:schema)) | ||
| 802 | ;; because each node can install its own alias type so the schema | ||
| 803 | ;; nodes might have a different prefix. | ||
| 804 | (when (consp node) | ||
| 805 | (soap-with-local-xmlns node | ||
| 806 | (when (eq (soap-l2wk (xml-node-name node)) 'xsd:schema) | ||
| 807 | (soap-wsdl-add-namespace (soap-parse-schema node) wsdl)))))) | ||
| 808 | |||
| 809 | (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) | ||
| 810 | (dolist (node (soap-xml-get-children1 node 'wsdl:message)) | ||
| 811 | (soap-namespace-put (soap-parse-message node) ns)) | ||
| 812 | |||
| 813 | (dolist (node (soap-xml-get-children1 node 'wsdl:portType)) | ||
| 814 | (let ((port-type (soap-parse-port-type node))) | ||
| 815 | (soap-namespace-put port-type ns) | ||
| 816 | (soap-wsdl-add-namespace | ||
| 817 | (soap-port-type-operations port-type) wsdl))) | ||
| 818 | |||
| 819 | (dolist (node (soap-xml-get-children1 node 'wsdl:binding)) | ||
| 820 | (soap-namespace-put (soap-parse-binding node) ns)) | ||
| 821 | |||
| 822 | (dolist (node (soap-xml-get-children1 node 'wsdl:service)) | ||
| 823 | (dolist (node (soap-xml-get-children1 node 'wsdl:port)) | ||
| 824 | (let ((name (xml-get-attribute node 'name)) | ||
| 825 | (binding (xml-get-attribute node 'binding)) | ||
| 826 | (url (let ((n (car (soap-xml-get-children1 | ||
| 827 | node 'wsdlsoap:address)))) | ||
| 828 | (xml-get-attribute n 'location)))) | ||
| 829 | (let ((port (make-soap-port | ||
| 830 | :name name :binding (soap-l2fq binding 'tns) | ||
| 831 | :service-url url))) | ||
| 832 | (soap-namespace-put port ns) | ||
| 833 | (push port (soap-wsdl-ports wsdl)))))) | ||
| 834 | |||
| 835 | (soap-wsdl-add-namespace ns wsdl)) | ||
| 836 | |||
| 837 | (soap-wsdl-resolve-references wsdl) | ||
| 838 | |||
| 839 | wsdl))) | ||
| 840 | |||
| 841 | (defun soap-parse-schema (node) | ||
| 842 | "Parse a schema NODE. | ||
| 843 | Return a SOAP-NAMESPACE containing the elements." | ||
| 844 | (soap-with-local-xmlns node | ||
| 845 | (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema) | ||
| 846 | nil | ||
| 847 | "soap-parse-schema: expecting an xsd:schema node, got %s" | ||
| 848 | (soap-l2wk (xml-node-name node))) | ||
| 849 | (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) | ||
| 850 | ;; NOTE: we only extract the complexTypes from the schema, we wouldn't | ||
| 851 | ;; know how to handle basic types beyond the built in ones anyway. | ||
| 852 | (dolist (node (soap-xml-get-children1 node 'xsd:complexType)) | ||
| 853 | (soap-namespace-put (soap-parse-complex-type node) ns)) | ||
| 854 | |||
| 855 | (dolist (node (soap-xml-get-children1 node 'xsd:element)) | ||
| 856 | (soap-namespace-put (soap-parse-schema-element node) ns)) | ||
| 857 | |||
| 858 | ns))) | ||
| 859 | |||
| 860 | (defun soap-parse-schema-element (node) | ||
| 861 | "Parse NODE and construct a schema element from it." | ||
| 862 | (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element) | ||
| 863 | nil | ||
| 864 | "soap-parse-schema-element: expecting xsd:element node, got %s" | ||
| 865 | (soap-l2wk (xml-node-name node))) | ||
| 866 | (let ((name (xml-get-attribute-or-nil node 'name)) | ||
| 867 | type) | ||
| 868 | ;; A schema element that contains an inline complex type -- | ||
| 869 | ;; construct the actual complex type for it. | ||
| 870 | (let ((type-node (soap-xml-get-children1 node 'xsd:complexType))) | ||
| 871 | (when (> (length type-node) 0) | ||
| 872 | (assert (= (length type-node) 1)) ; only one complex type | ||
| 873 | ; definition per element | ||
| 874 | (setq type (soap-parse-complex-type (car type-node))))) | ||
| 875 | (setf (soap-element-name type) name) | ||
| 876 | type)) | ||
| 877 | |||
| 878 | (defun soap-parse-complex-type (node) | ||
| 879 | "Parse NODE and construct a complex type from it." | ||
| 880 | (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexType) | ||
| 881 | nil | ||
| 882 | "soap-parse-complex-type: expecting xsd:complexType node, got %s" | ||
| 883 | (soap-l2wk (xml-node-name node))) | ||
| 884 | (let ((name (xml-get-attribute-or-nil node 'name)) | ||
| 885 | ;; Use a dummy type for the complex type, it will be replaced | ||
| 886 | ;; with the real type below, except when the complex type node | ||
| 887 | ;; is empty... | ||
| 888 | (type (make-soap-sequence-type :elements nil))) | ||
| 889 | (dolist (c (xml-node-children node)) | ||
| 890 | (when (consp c) ; skip string nodes, which are whitespace | ||
| 891 | (let ((node-name (soap-l2wk (xml-node-name c)))) | ||
| 892 | (cond | ||
| 893 | ((eq node-name 'xsd:sequence) | ||
| 894 | (setq type (soap-parse-complex-type-sequence c))) | ||
| 895 | ((eq node-name 'xsd:complexContent) | ||
| 896 | (setq type (soap-parse-complex-type-complex-content c))) | ||
| 897 | ((eq node-name 'xsd:attribute) | ||
| 898 | ;; The name of this node comes from an attribute tag | ||
| 899 | (let ((n (xml-get-attribute-or-nil c 'name))) | ||
| 900 | (setq name n))) | ||
| 901 | (t | ||
| 902 | (error "Unknown node type %s" node-name)))))) | ||
| 903 | (setf (soap-element-name type) name) | ||
| 904 | type)) | ||
| 905 | |||
| 906 | (defun soap-parse-sequence (node) | ||
| 907 | "Parse NODE and a list of sequence elements that it defines. | ||
| 908 | NODE is assumed to be an xsd:sequence node. In that case, each | ||
| 909 | of its children is assumed to be a sequence element. Each | ||
| 910 | sequence element is parsed constructing the corresponding type. | ||
| 911 | A list of these types is returned." | ||
| 912 | (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:sequence) | ||
| 913 | nil | ||
| 914 | "soap-parse-sequence: expecting xsd:sequence node, got %s" | ||
| 915 | (soap-l2wk (xml-node-name node))) | ||
| 916 | (let (elements) | ||
| 917 | (dolist (e (soap-xml-get-children1 node 'xsd:element)) | ||
| 918 | (let ((name (xml-get-attribute-or-nil e 'name)) | ||
| 919 | (type (xml-get-attribute-or-nil e 'type)) | ||
| 920 | (nillable? (or (equal (xml-get-attribute-or-nil e 'nillable) "true") | ||
| 921 | (let ((e (xml-get-attribute-or-nil e 'minOccurs))) | ||
| 922 | (and e (equal e "0"))))) | ||
| 923 | (multiple? (let ((e (xml-get-attribute-or-nil e 'maxOccurs))) | ||
| 924 | (and e (not (equal e "1")))))) | ||
| 925 | (if type | ||
| 926 | (setq type (soap-l2fq type 'tns)) | ||
| 927 | |||
| 928 | ;; The node does not have a type, maybe it has a complexType | ||
| 929 | ;; defined inline... | ||
| 930 | (let ((type-node (soap-xml-get-children1 e 'xsd:complexType))) | ||
| 931 | (when (> (length type-node) 0) | ||
| 932 | (assert (= (length type-node) 1) | ||
| 933 | nil | ||
| 934 | "only one complex type definition per element supported") | ||
| 935 | (setq type (soap-parse-complex-type (car type-node)))))) | ||
| 936 | |||
| 937 | (push (make-soap-sequence-element | ||
| 938 | :name (intern name) :type type :nillable? nillable? | ||
| 939 | :multiple? multiple?) | ||
| 940 | elements))) | ||
| 941 | (nreverse elements))) | ||
| 942 | |||
| 943 | (defun soap-parse-complex-type-sequence (node) | ||
| 944 | "Parse NODE as a sequence type." | ||
| 945 | (let ((elements (soap-parse-sequence node))) | ||
| 946 | (make-soap-sequence-type :elements elements))) | ||
| 947 | |||
| 948 | (defun soap-parse-complex-type-complex-content (node) | ||
| 949 | "Parse NODE as a xsd:complexContent node. | ||
| 950 | A sequence or an array type is returned depending on the actual | ||
| 951 | contents." | ||
| 952 | (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexContent) | ||
| 953 | nil | ||
| 954 | "soap-parse-complex-type-complex-content: expecting xsd:complexContent node, got %s" | ||
| 955 | (soap-l2wk (xml-node-name node))) | ||
| 956 | (let (array? parent elements) | ||
| 957 | (let ((extension (car-safe (soap-xml-get-children1 node 'xsd:extension))) | ||
| 958 | (restriction (car-safe | ||
| 959 | (soap-xml-get-children1 node 'xsd:restriction)))) | ||
| 960 | ;; a complex content node is either an extension or a restriction | ||
| 961 | (cond (extension | ||
| 962 | (setq parent (xml-get-attribute-or-nil extension 'base)) | ||
| 963 | (setq elements (soap-parse-sequence | ||
| 964 | (car (soap-xml-get-children1 | ||
| 965 | extension 'xsd:sequence))))) | ||
| 966 | (restriction | ||
| 967 | (let ((base (xml-get-attribute-or-nil restriction 'base))) | ||
| 968 | (assert (equal base "soapenc:Array") | ||
| 969 | nil | ||
| 970 | "restrictions supported only for soapenc:Array types, this is a %s" | ||
| 971 | base)) | ||
| 972 | (setq array? t) | ||
| 973 | (let ((attribute (car (soap-xml-get-children1 | ||
| 974 | restriction 'xsd:attribute)))) | ||
| 975 | (let ((array-type (soap-xml-get-attribute-or-nil1 | ||
| 976 | attribute 'wsdl:arrayType))) | ||
| 977 | (when (string-match "^\\(.*\\)\\[\\]$" array-type) | ||
| 978 | (setq parent (match-string 1 array-type)))))) | ||
| 979 | |||
| 980 | (t | ||
| 981 | (error "Unknown complex type")))) | ||
| 982 | |||
| 983 | (if parent | ||
| 984 | (setq parent (soap-l2fq parent 'tns))) | ||
| 985 | |||
| 986 | (if array? | ||
| 987 | (make-soap-array-type :element-type parent) | ||
| 988 | (make-soap-sequence-type :parent parent :elements elements)))) | ||
| 989 | |||
| 990 | (defun soap-parse-message (node) | ||
| 991 | "Parse NODE as a wsdl:message and return the corresponding type." | ||
| 992 | (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:message) | ||
| 993 | nil | ||
| 994 | "soap-parse-message: expecting wsdl:message node, got %s" | ||
| 995 | (soap-l2wk (xml-node-name node))) | ||
| 996 | (let ((name (xml-get-attribute-or-nil node 'name)) | ||
| 997 | parts) | ||
| 998 | (dolist (p (soap-xml-get-children1 node 'wsdl:part)) | ||
| 999 | (let ((name (xml-get-attribute-or-nil p 'name)) | ||
| 1000 | (type (xml-get-attribute-or-nil p 'type)) | ||
| 1001 | (element (xml-get-attribute-or-nil p 'element))) | ||
| 1002 | |||
| 1003 | (when type | ||
| 1004 | (setq type (soap-l2fq type 'tns))) | ||
| 1005 | |||
| 1006 | (when element | ||
| 1007 | (setq element (soap-l2fq element 'tns))) | ||
| 1008 | |||
| 1009 | (push (cons name (or type element)) parts))) | ||
| 1010 | (make-soap-message :name name :parts (nreverse parts)))) | ||
| 1011 | |||
| 1012 | (defun soap-parse-port-type (node) | ||
| 1013 | "Parse NODE as a wsdl:portType and return the corresponding port." | ||
| 1014 | (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:portType) | ||
| 1015 | nil | ||
| 1016 | "soap-parse-port-type: expecting wsdl:portType node got %s" | ||
| 1017 | (soap-l2wk (xml-node-name node))) | ||
| 1018 | (let ((ns (make-soap-namespace | ||
| 1019 | :name (concat "urn:" (xml-get-attribute node 'name))))) | ||
| 1020 | (dolist (node (soap-xml-get-children1 node 'wsdl:operation)) | ||
| 1021 | (let ((o (soap-parse-operation node))) | ||
| 1022 | |||
| 1023 | (let ((other-operation (soap-namespace-get | ||
| 1024 | (soap-element-name o) ns 'soap-operation-p))) | ||
| 1025 | (if other-operation | ||
| 1026 | ;; Unfortunately, the Confluence WSDL defines two operations | ||
| 1027 | ;; named "search" which differ only in parameter names... | ||
| 1028 | (soap-warning "Discarding duplicate operation: %s" | ||
| 1029 | (soap-element-name o)) | ||
| 1030 | |||
| 1031 | (progn | ||
| 1032 | (soap-namespace-put o ns) | ||
| 1033 | |||
| 1034 | ;; link all messages from this namespace, as this namespace | ||
| 1035 | ;; will be used for decoding the response. | ||
| 1036 | (destructuring-bind (name . message) (soap-operation-input o) | ||
| 1037 | (soap-namespace-put-link name message ns)) | ||
| 1038 | |||
| 1039 | (destructuring-bind (name . message) (soap-operation-output o) | ||
| 1040 | (soap-namespace-put-link name message ns)) | ||
| 1041 | |||
| 1042 | (dolist (fault (soap-operation-faults o)) | ||
| 1043 | (destructuring-bind (name . message) fault | ||
| 1044 | (soap-namespace-put-link name message ns 'replace))) | ||
| 1045 | |||
| 1046 | ))))) | ||
| 1047 | |||
| 1048 | (make-soap-port-type :name (xml-get-attribute node 'name) | ||
| 1049 | :operations ns))) | ||
| 1050 | |||
| 1051 | (defun soap-parse-operation (node) | ||
| 1052 | "Parse NODE as a wsdl:operation and return the corresponding type." | ||
| 1053 | (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:operation) | ||
| 1054 | nil | ||
| 1055 | "soap-parse-operation: expecting wsdl:operation node, got %s" | ||
| 1056 | (soap-l2wk (xml-node-name node))) | ||
| 1057 | (let ((name (xml-get-attribute node 'name)) | ||
| 1058 | (parameter-order (split-string | ||
| 1059 | (xml-get-attribute node 'parameterOrder))) | ||
| 1060 | input output faults) | ||
| 1061 | (dolist (n (xml-node-children node)) | ||
| 1062 | (when (consp n) ; skip string nodes which are whitespace | ||
| 1063 | (let ((node-name (soap-l2wk (xml-node-name n)))) | ||
| 1064 | (cond | ||
| 1065 | ((eq node-name 'wsdl:input) | ||
| 1066 | (let ((message (xml-get-attribute n 'message)) | ||
| 1067 | (name (xml-get-attribute n 'name))) | ||
| 1068 | (setq input (cons name (soap-l2fq message 'tns))))) | ||
| 1069 | ((eq node-name 'wsdl:output) | ||
| 1070 | (let ((message (xml-get-attribute n 'message)) | ||
| 1071 | (name (xml-get-attribute n 'name))) | ||
| 1072 | (setq output (cons name (soap-l2fq message 'tns))))) | ||
| 1073 | ((eq node-name 'wsdl:fault) | ||
| 1074 | (let ((message (xml-get-attribute n 'message)) | ||
| 1075 | (name (xml-get-attribute n 'name))) | ||
| 1076 | (push (cons name (soap-l2fq message 'tns)) faults))))))) | ||
| 1077 | (make-soap-operation | ||
| 1078 | :name name | ||
| 1079 | :parameter-order parameter-order | ||
| 1080 | :input input | ||
| 1081 | :output output | ||
| 1082 | :faults (nreverse faults)))) | ||
| 1083 | |||
| 1084 | (defun soap-parse-binding (node) | ||
| 1085 | "Parse NODE as a wsdl:binding and return the corresponding type." | ||
| 1086 | (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:binding) | ||
| 1087 | nil | ||
| 1088 | "soap-parse-binding: expecting wsdl:binding node, got %s" | ||
| 1089 | (soap-l2wk (xml-node-name node))) | ||
| 1090 | (let ((name (xml-get-attribute node 'name)) | ||
| 1091 | (type (xml-get-attribute node 'type))) | ||
| 1092 | (let ((binding (make-soap-binding :name name | ||
| 1093 | :port-type (soap-l2fq type 'tns)))) | ||
| 1094 | (dolist (wo (soap-xml-get-children1 node 'wsdl:operation)) | ||
| 1095 | (let ((name (xml-get-attribute wo 'name)) | ||
| 1096 | soap-action | ||
| 1097 | use) | ||
| 1098 | (dolist (so (soap-xml-get-children1 wo 'wsdlsoap:operation)) | ||
| 1099 | (setq soap-action (xml-get-attribute-or-nil so 'soapAction))) | ||
| 1100 | |||
| 1101 | ;; Search a wsdlsoap:body node and find a "use" tag. The | ||
| 1102 | ;; same use tag is assumed to be present for both input and | ||
| 1103 | ;; output types (although the WDSL spec allows separate | ||
| 1104 | ;; "use"-s for each of them... | ||
| 1105 | |||
| 1106 | (dolist (i (soap-xml-get-children1 wo 'wsdl:input)) | ||
| 1107 | (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body)) | ||
| 1108 | (setq use (or use | ||
| 1109 | (xml-get-attribute-or-nil b 'use))))) | ||
| 1110 | |||
| 1111 | (unless use | ||
| 1112 | (dolist (i (soap-xml-get-children1 wo 'wsdl:output)) | ||
| 1113 | (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body)) | ||
| 1114 | (setq use (or use | ||
| 1115 | (xml-get-attribute-or-nil b 'use)))))) | ||
| 1116 | |||
| 1117 | (puthash name (make-soap-bound-operation :operation name | ||
| 1118 | :soap-action soap-action | ||
| 1119 | :use (and use (intern use))) | ||
| 1120 | (soap-binding-operations binding)))) | ||
| 1121 | binding))) | ||
| 1122 | |||
| 1123 | ;;;; SOAP type decoding | ||
| 1124 | |||
| 1125 | (defvar soap-multi-refs nil | ||
| 1126 | "The list of multi-ref nodes in the current SOAP response. | ||
| 1127 | This is a dynamically bound variable used during decoding the | ||
| 1128 | SOAP response.") | ||
| 1129 | |||
| 1130 | (defvar soap-decoded-multi-refs nil | ||
| 1131 | "List of decoded multi-ref nodes in the current SOAP response. | ||
| 1132 | This is a dynamically bound variable used during decoding the | ||
| 1133 | SOAP response.") | ||
| 1134 | |||
| 1135 | (defvar soap-current-wsdl nil | ||
| 1136 | "The current WSDL document used when decoding the SOAP response. | ||
| 1137 | This is a dynamically bound variable.") | ||
| 1138 | |||
| 1139 | (defun soap-decode-type (type node) | ||
| 1140 | "Use TYPE (an xsd type) to decode the contents of NODE. | ||
| 1141 | |||
| 1142 | NODE is an XML node, representing some SOAP encoded value or a | ||
| 1143 | reference to another XML node (a multiRef). This function will | ||
| 1144 | resolve the multiRef reference, if any, than call a TYPE specific | ||
| 1145 | decode function to perform the actual decoding." | ||
| 1146 | (let ((href (xml-get-attribute-or-nil node 'href))) | ||
| 1147 | (cond (href | ||
| 1148 | (catch 'done | ||
| 1149 | ;; NODE is actually a HREF, find the target and decode that. | ||
| 1150 | ;; Check first if we already decoded this multiref. | ||
| 1151 | |||
| 1152 | (let ((decoded (cdr (assoc href soap-decoded-multi-refs)))) | ||
| 1153 | (when decoded | ||
| 1154 | (throw 'done decoded))) | ||
| 1155 | |||
| 1156 | (string-match "^#\\(.*\\)$" href) ; TODO: check that it matched | ||
| 1157 | |||
| 1158 | (let ((id (match-string 1 href))) | ||
| 1159 | (dolist (mr soap-multi-refs) | ||
| 1160 | (let ((mrid (xml-get-attribute mr 'id))) | ||
| 1161 | (when (equal id mrid) | ||
| 1162 | ;; recurse here, in case there are multiple HREF's | ||
| 1163 | (let ((decoded (soap-decode-type type mr))) | ||
| 1164 | (push (cons href decoded) soap-decoded-multi-refs) | ||
| 1165 | (throw 'done decoded))))) | ||
| 1166 | (error "Cannot find href %s" href)))) | ||
| 1167 | (t | ||
| 1168 | (soap-with-local-xmlns node | ||
| 1169 | (if (equal (soap-xml-get-attribute-or-nil1 node 'xsi:nil) "true") | ||
| 1170 | nil | ||
| 1171 | (let ((decoder (get (aref type 0) 'soap-decoder))) | ||
| 1172 | (assert decoder nil "no soap-decoder for %s type" | ||
| 1173 | (aref type 0)) | ||
| 1174 | (funcall decoder type node)))))))) | ||
| 1175 | |||
| 1176 | (defun soap-decode-any-type (node) | ||
| 1177 | "Decode NODE using type information inside it." | ||
| 1178 | ;; If the NODE has type information, we use that... | ||
| 1179 | (let ((type (soap-xml-get-attribute-or-nil1 node 'xsi:type))) | ||
| 1180 | (if type | ||
| 1181 | (let ((wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p))) | ||
| 1182 | (if wtype | ||
| 1183 | (soap-decode-type wtype node) | ||
| 1184 | ;; The node has type info encoded in it, but we don't know how | ||
| 1185 | ;; to decode it... | ||
| 1186 | (error "Soap-decode-any-type: node has unknown type: %s" type))) | ||
| 1187 | |||
| 1188 | ;; No type info in the node... | ||
| 1189 | |||
| 1190 | (let ((contents (xml-node-children node))) | ||
| 1191 | (if (and (= (length contents) 1) (stringp (car contents))) | ||
| 1192 | ;; contents is just a string | ||
| 1193 | (car contents) | ||
| 1194 | |||
| 1195 | ;; we assume the NODE is a sequence with every element a | ||
| 1196 | ;; structure name | ||
| 1197 | (let (result) | ||
| 1198 | (dolist (element contents) | ||
| 1199 | (let ((key (xml-node-name element)) | ||
| 1200 | (value (soap-decode-any-type element))) | ||
| 1201 | (push (cons key value) result))) | ||
| 1202 | (nreverse result))))))) | ||
| 1203 | |||
| 1204 | (defun soap-decode-array (node) | ||
| 1205 | "Decode NODE as an Array using type information inside it." | ||
| 1206 | (let ((type (soap-xml-get-attribute-or-nil1 node 'soapenc:arrayType)) | ||
| 1207 | (wtype nil) | ||
| 1208 | (contents (xml-node-children node)) | ||
| 1209 | result) | ||
| 1210 | (when type | ||
| 1211 | ;; Type is in the format "someType[NUM]" where NUM is the number of | ||
| 1212 | ;; elements in the array. We discard the [NUM] part. | ||
| 1213 | (setq type (replace-regexp-in-string "\\[[0-9]+\\]\\'" "" type)) | ||
| 1214 | (setq wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p)) | ||
| 1215 | (unless wtype | ||
| 1216 | ;; The node has type info encoded in it, but we don't know how to | ||
| 1217 | ;; decode it... | ||
| 1218 | (error "Soap-decode-array: node has unknown type: %s" type))) | ||
| 1219 | (dolist (e contents) | ||
| 1220 | (when (consp e) | ||
| 1221 | (push (if wtype | ||
| 1222 | (soap-decode-type wtype e) | ||
| 1223 | (soap-decode-any-type e)) | ||
| 1224 | result))) | ||
| 1225 | (nreverse result))) | ||
| 1226 | |||
| 1227 | (defun soap-decode-basic-type (type node) | ||
| 1228 | "Use TYPE to decode the contents of NODE. | ||
| 1229 | TYPE is a `soap-basic-type' struct, and NODE is an XML document. | ||
| 1230 | A LISP value is returned based on the contents of NODE and the | ||
| 1231 | type-info stored in TYPE." | ||
| 1232 | (let ((contents (xml-node-children node)) | ||
| 1233 | (type-kind (soap-basic-type-kind type))) | ||
| 1234 | |||
| 1235 | (if (null contents) | ||
| 1236 | nil | ||
| 1237 | (ecase type-kind | ||
| 1238 | (string (car contents)) | ||
| 1239 | (dateTime (car contents)) ; TODO: convert to a date time | ||
| 1240 | ((long int float) (string-to-number (car contents))) | ||
| 1241 | (boolean (string= (downcase (car contents)) "true")) | ||
| 1242 | (base64Binary (base64-decode-string (car contents))) | ||
| 1243 | (anyType (soap-decode-any-type node)) | ||
| 1244 | (Array (soap-decode-array node)))))) | ||
| 1245 | |||
| 1246 | (defun soap-decode-sequence-type (type node) | ||
| 1247 | "Use TYPE to decode the contents of NODE. | ||
| 1248 | TYPE is assumed to be a sequence type and an ALIST with the | ||
| 1249 | contents of the NODE is returned." | ||
| 1250 | (let ((result nil) | ||
| 1251 | (parent (soap-sequence-type-parent type))) | ||
| 1252 | (when parent | ||
| 1253 | (setq result (nreverse (soap-decode-type parent node)))) | ||
| 1254 | (dolist (element (soap-sequence-type-elements type)) | ||
| 1255 | (let ((instance-count 0) | ||
| 1256 | (e-name (soap-sequence-element-name element)) | ||
| 1257 | (e-type (soap-sequence-element-type element))) | ||
| 1258 | (dolist (node (xml-get-children node e-name)) | ||
| 1259 | (incf instance-count) | ||
| 1260 | (push (cons e-name (soap-decode-type e-type node)) result)) | ||
| 1261 | ;; Do some sanity checking | ||
| 1262 | (cond ((and (= instance-count 0) | ||
| 1263 | (not (soap-sequence-element-nillable? element))) | ||
| 1264 | (soap-warning "While decoding %s: missing non-nillable slot %s" | ||
| 1265 | (soap-element-name type) e-name)) | ||
| 1266 | ((and (> instance-count 1) | ||
| 1267 | (not (soap-sequence-element-multiple? element))) | ||
| 1268 | (soap-warning "While decoding %s: multiple slots named %s" | ||
| 1269 | (soap-element-name type) e-name))))) | ||
| 1270 | (nreverse result))) | ||
| 1271 | |||
| 1272 | (defun soap-decode-array-type (type node) | ||
| 1273 | "Use TYPE to decode the contents of NODE. | ||
| 1274 | TYPE is assumed to be an array type. Arrays are decoded as lists. | ||
| 1275 | This is because it is easier to work with list results in LISP." | ||
| 1276 | (let ((result nil) | ||
| 1277 | (element-type (soap-array-type-element-type type))) | ||
| 1278 | (dolist (node (xml-node-children node)) | ||
| 1279 | (when (consp node) | ||
| 1280 | (push (soap-decode-type element-type node) result))) | ||
| 1281 | (nreverse result))) | ||
| 1282 | |||
| 1283 | (progn | ||
| 1284 | (put (aref (make-soap-basic-type) 0) | ||
| 1285 | 'soap-decoder 'soap-decode-basic-type) | ||
| 1286 | (put (aref (make-soap-sequence-type) 0) | ||
| 1287 | 'soap-decoder 'soap-decode-sequence-type) | ||
| 1288 | (put (aref (make-soap-array-type) 0) | ||
| 1289 | 'soap-decoder 'soap-decode-array-type)) | ||
| 1290 | |||
| 1291 | ;;;; Soap Envelope parsing | ||
| 1292 | |||
| 1293 | (put 'soap-error | ||
| 1294 | 'error-conditions | ||
| 1295 | '(error soap-error)) | ||
| 1296 | (put 'soap-error 'error-message "SOAP error") | ||
| 1297 | |||
| 1298 | (defun soap-parse-envelope (node operation wsdl) | ||
| 1299 | "Parse the SOAP envelope in NODE and return the response. | ||
| 1300 | OPERATION is the WSDL operation for which we expect the response, | ||
| 1301 | WSDL is used to decode the NODE" | ||
| 1302 | (soap-with-local-xmlns node | ||
| 1303 | (assert (eq (soap-l2wk (xml-node-name node)) 'soap:Envelope) | ||
| 1304 | nil | ||
| 1305 | "soap-parse-envelope: expecting soap:Envelope node, got %s" | ||
| 1306 | (soap-l2wk (xml-node-name node))) | ||
| 1307 | (let ((body (car (soap-xml-get-children1 node 'soap:Body)))) | ||
| 1308 | |||
| 1309 | (let ((fault (car (soap-xml-get-children1 body 'soap:Fault)))) | ||
| 1310 | (when fault | ||
| 1311 | (let ((fault-code (let ((n (car (xml-get-children | ||
| 1312 | fault 'faultcode)))) | ||
| 1313 | (car-safe (xml-node-children n)))) | ||
| 1314 | (fault-string (let ((n (car (xml-get-children | ||
| 1315 | fault 'faultstring)))) | ||
| 1316 | (car-safe (xml-node-children n))))) | ||
| 1317 | (while t | ||
| 1318 | (signal 'soap-error (list fault-code fault-string)))))) | ||
| 1319 | |||
| 1320 | ;; First (non string) element of the body is the root node of he | ||
| 1321 | ;; response | ||
| 1322 | (let ((response (if (eq (soap-bound-operation-use operation) 'literal) | ||
| 1323 | ;; For 'literal uses, the response is the actual body | ||
| 1324 | body | ||
| 1325 | ;; ...otherwise the first non string element | ||
| 1326 | ;; of the body is the response | ||
| 1327 | (catch 'found | ||
| 1328 | (dolist (n (xml-node-children body)) | ||
| 1329 | (when (consp n) | ||
| 1330 | (throw 'found n))))))) | ||
| 1331 | (soap-parse-response response operation wsdl body))))) | ||
| 1332 | |||
| 1333 | (defun soap-parse-response (response-node operation wsdl soap-body) | ||
| 1334 | "Parse RESPONSE-NODE and return the result as a LISP value. | ||
| 1335 | OPERATION is the WSDL operation for which we expect the response, | ||
| 1336 | WSDL is used to decode the NODE. | ||
| 1337 | |||
| 1338 | SOAP-BODY is the body of the SOAP envelope (of which | ||
| 1339 | RESPONSE-NODE is a sub-node). It is used in case RESPONSE-NODE | ||
| 1340 | reference multiRef parts which are external to RESPONSE-NODE." | ||
| 1341 | (let* ((soap-current-wsdl wsdl) | ||
| 1342 | (op (soap-bound-operation-operation operation)) | ||
| 1343 | (use (soap-bound-operation-use operation)) | ||
| 1344 | (message (cdr (soap-operation-output op)))) | ||
| 1345 | |||
| 1346 | (soap-with-local-xmlns response-node | ||
| 1347 | |||
| 1348 | (when (eq use 'encoded) | ||
| 1349 | (let* ((received-message-name (soap-l2fq (xml-node-name response-node))) | ||
| 1350 | (received-message (soap-wsdl-get | ||
| 1351 | received-message-name wsdl 'soap-message-p))) | ||
| 1352 | (unless (eq received-message message) | ||
| 1353 | (error "Unexpected message: got %s, expecting %s" | ||
| 1354 | received-message-name | ||
| 1355 | (soap-element-name message))))) | ||
| 1356 | |||
| 1357 | (let ((decoded-parts nil) | ||
| 1358 | (soap-multi-refs (xml-get-children soap-body 'multiRef)) | ||
| 1359 | (soap-decoded-multi-refs nil)) | ||
| 1360 | |||
| 1361 | (dolist (part (soap-message-parts message)) | ||
| 1362 | (let ((tag (car part)) | ||
| 1363 | (type (cdr part)) | ||
| 1364 | node) | ||
| 1365 | |||
| 1366 | (setq node | ||
| 1367 | (cond | ||
| 1368 | ((eq use 'encoded) | ||
| 1369 | (car (xml-get-children response-node tag))) | ||
| 1370 | |||
| 1371 | ((eq use 'literal) | ||
| 1372 | (catch 'found | ||
| 1373 | (let* ((ns-aliases (soap-wsdl-alias-table wsdl)) | ||
| 1374 | (ns-name (cdr (assoc | ||
| 1375 | (soap-element-namespace-tag type) | ||
| 1376 | ns-aliases))) | ||
| 1377 | (fqname (cons ns-name (soap-element-name type)))) | ||
| 1378 | (dolist (c (xml-node-children response-node)) | ||
| 1379 | (when (consp c) | ||
| 1380 | (soap-with-local-xmlns c | ||
| 1381 | (when (equal (soap-l2fq (xml-node-name c)) | ||
| 1382 | fqname) | ||
| 1383 | (throw 'found c)))))))))) | ||
| 1384 | |||
| 1385 | (unless node | ||
| 1386 | (error "Soap-parse-response(%s): cannot find message part %s" | ||
| 1387 | (soap-element-name op) tag)) | ||
| 1388 | (push (soap-decode-type type node) decoded-parts))) | ||
| 1389 | |||
| 1390 | decoded-parts)))) | ||
| 1391 | |||
| 1392 | ;;;; SOAP type encoding | ||
| 1393 | |||
| 1394 | (defvar soap-encoded-namespaces nil | ||
| 1395 | "A list of namespace tags used during encoding a message. | ||
| 1396 | This list is populated by `soap-encode-value' and used by | ||
| 1397 | `soap-create-envelope' to add aliases for these namespace to the | ||
| 1398 | XML request. | ||
| 1399 | |||
| 1400 | This variable is dynamically bound in `soap-create-envelope'.") | ||
| 1401 | |||
| 1402 | (defun soap-encode-value (xml-tag value type) | ||
| 1403 | "Encode inside an XML-TAG the VALUE using TYPE. | ||
| 1404 | The resulting XML data is inserted in the current buffer | ||
| 1405 | at (point)/ | ||
| 1406 | |||
| 1407 | TYPE is one of the soap-*-type structures which defines how VALUE | ||
| 1408 | is to be encoded. This is a generic function which finds an | ||
| 1409 | encoder function based on TYPE and calls that encoder to do the | ||
| 1410 | work." | ||
| 1411 | (let ((encoder (get (aref type 0) 'soap-encoder))) | ||
| 1412 | (assert encoder nil "no soap-encoder for %s type" (aref type 0)) | ||
| 1413 | ;; XML-TAG can be a string or a symbol, but we pass only string's to the | ||
| 1414 | ;; encoders | ||
| 1415 | (when (symbolp xml-tag) | ||
| 1416 | (setq xml-tag (symbol-name xml-tag))) | ||
| 1417 | (funcall encoder xml-tag value type)) | ||
| 1418 | (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type))) | ||
| 1419 | |||
| 1420 | (defun soap-encode-basic-type (xml-tag value type) | ||
| 1421 | "Encode inside XML-TAG the LISP VALUE according to TYPE. | ||
| 1422 | Do not call this function directly, use `soap-encode-value' | ||
| 1423 | instead." | ||
| 1424 | (let ((xsi-type (soap-element-fq-name type)) | ||
| 1425 | (basic-type (soap-basic-type-kind type))) | ||
| 1426 | |||
| 1427 | ;; try to classify the type based on the value type and use that type when | ||
| 1428 | ;; encoding | ||
| 1429 | (when (eq basic-type 'anyType) | ||
| 1430 | (cond ((stringp value) | ||
| 1431 | (setq xsi-type "xsd:string" basic-type 'string)) | ||
| 1432 | ((integerp value) | ||
| 1433 | (setq xsi-type "xsd:int" basic-type 'int)) | ||
| 1434 | ((memq value '(t nil)) | ||
| 1435 | (setq xsi-type "xsd:boolean" basic-type 'boolean)) | ||
| 1436 | (t | ||
| 1437 | (error | ||
| 1438 | "Soap-encode-basic-type(%s, %s, %s): cannot classify anyType value" | ||
| 1439 | xml-tag value xsi-type)))) | ||
| 1440 | |||
| 1441 | (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") | ||
| 1442 | |||
| 1443 | ;; We have some ambiguity here, as a nil value represents "false" when the | ||
| 1444 | ;; type is boolean, we will never have a "nil" boolean type... | ||
| 1445 | |||
| 1446 | (if (or value (eq basic-type 'boolean)) | ||
| 1447 | (progn | ||
| 1448 | (insert ">") | ||
| 1449 | (case basic-type | ||
| 1450 | (string | ||
| 1451 | (unless (stringp value) | ||
| 1452 | (error "Soap-encode-basic-type(%s, %s, %s): not a string value" | ||
| 1453 | xml-tag value xsi-type)) | ||
| 1454 | (insert (url-insert-entities-in-string value))) | ||
| 1455 | |||
| 1456 | (dateTime | ||
| 1457 | (cond ((and (consp value) ; is there a time-value-p ? | ||
| 1458 | (>= (length value) 2) | ||
| 1459 | (numberp (nth 0 value)) | ||
| 1460 | (numberp (nth 1 value))) | ||
| 1461 | ;; Value is a (current-time) style value, convert | ||
| 1462 | ;; to a string | ||
| 1463 | (insert (format-time-string "%Y-%m-%dT%H:%M:%S" value))) | ||
| 1464 | ((stringp value) | ||
| 1465 | (insert (url-insert-entities-in-string value))) | ||
| 1466 | (t | ||
| 1467 | (error | ||
| 1468 | "Soap-encode-basic-type(%s, %s, %s): not a dateTime value" | ||
| 1469 | xml-tag value xsi-type)))) | ||
| 1470 | |||
| 1471 | (boolean | ||
| 1472 | (unless (memq value '(t nil)) | ||
| 1473 | (error "Soap-encode-basic-type(%s, %s, %s): not a boolean value" | ||
| 1474 | xml-tag value xsi-type)) | ||
| 1475 | (insert (if value "true" "false"))) | ||
| 1476 | |||
| 1477 | ((long int) | ||
| 1478 | (unless (integerp value) | ||
| 1479 | (error "Soap-encode-basic-type(%s, %s, %s): not an integer value" | ||
| 1480 | xml-tag value xsi-type)) | ||
| 1481 | (insert (number-to-string value))) | ||
| 1482 | |||
| 1483 | (base64Binary | ||
| 1484 | (unless (stringp value) | ||
| 1485 | (error "Soap-encode-basic-type(%s, %s, %s): not a string value" | ||
| 1486 | xml-tag value xsi-type)) | ||
| 1487 | (insert (base64-encode-string value))) | ||
| 1488 | |||
| 1489 | (otherwise | ||
| 1490 | (error | ||
| 1491 | "Soap-encode-basic-type(%s, %s, %s): don't know how to encode" | ||
| 1492 | xml-tag value xsi-type)))) | ||
| 1493 | |||
| 1494 | (insert " xsi:nil=\"true\">")) | ||
| 1495 | (insert "</" xml-tag ">\n"))) | ||
| 1496 | |||
| 1497 | (defun soap-encode-sequence-type (xml-tag value type) | ||
| 1498 | "Encode inside XML-TAG the LISP VALUE according to TYPE. | ||
| 1499 | Do not call this function directly, use `soap-encode-value' | ||
| 1500 | instead." | ||
| 1501 | (let ((xsi-type (soap-element-fq-name type))) | ||
| 1502 | (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") | ||
| 1503 | (if value | ||
| 1504 | (progn | ||
| 1505 | (insert ">\n") | ||
| 1506 | (let ((parents (list type)) | ||
| 1507 | (parent (soap-sequence-type-parent type))) | ||
| 1508 | |||
| 1509 | (while parent | ||
| 1510 | (push parent parents) | ||
| 1511 | (setq parent (soap-sequence-type-parent parent))) | ||
| 1512 | |||
| 1513 | (dolist (type parents) | ||
| 1514 | (dolist (element (soap-sequence-type-elements type)) | ||
| 1515 | (let ((instance-count 0) | ||
| 1516 | (e-name (soap-sequence-element-name element)) | ||
| 1517 | (e-type (soap-sequence-element-type element))) | ||
| 1518 | (dolist (v value) | ||
| 1519 | (when (equal (car v) e-name) | ||
| 1520 | (incf instance-count) | ||
| 1521 | (soap-encode-value e-name (cdr v) e-type))) | ||
| 1522 | |||
| 1523 | ;; Do some sanity checking | ||
| 1524 | (cond ((and (= instance-count 0) | ||
| 1525 | (not (soap-sequence-element-nillable? element))) | ||
| 1526 | (soap-warning | ||
| 1527 | "While encoding %s: missing non-nillable slot %s" | ||
| 1528 | (soap-element-name type) e-name)) | ||
| 1529 | ((and (> instance-count 1) | ||
| 1530 | (not (soap-sequence-element-multiple? element))) | ||
| 1531 | (soap-warning | ||
| 1532 | "While encoding %s: multiple slots named %s" | ||
| 1533 | (soap-element-name type) e-name)))))))) | ||
| 1534 | (insert " xsi:nil=\"true\">")) | ||
| 1535 | (insert "</" xml-tag ">\n"))) | ||
| 1536 | |||
| 1537 | (defun soap-encode-array-type (xml-tag value type) | ||
| 1538 | "Encode inside XML-TAG the LISP VALUE according to TYPE. | ||
| 1539 | Do not call this function directly, use `soap-encode-value' | ||
| 1540 | instead." | ||
| 1541 | (unless (vectorp value) | ||
| 1542 | (error "Soap-encode: %s(%s) expects a vector, got: %s" | ||
| 1543 | xml-tag (soap-element-fq-name type) value)) | ||
| 1544 | (let* ((element-type (soap-array-type-element-type type)) | ||
| 1545 | (array-type (concat (soap-element-fq-name element-type) | ||
| 1546 | "[" (format "%s" (length value)) "]"))) | ||
| 1547 | (insert "<" xml-tag | ||
| 1548 | " soapenc:arrayType=\"" array-type "\" " | ||
| 1549 | " xsi:type=\"soapenc:Array\">\n") | ||
| 1550 | (loop for i below (length value) | ||
| 1551 | do (soap-encode-value xml-tag (aref value i) element-type)) | ||
| 1552 | (insert "</" xml-tag ">\n"))) | ||
| 1553 | |||
| 1554 | (progn | ||
| 1555 | (put (aref (make-soap-basic-type) 0) | ||
| 1556 | 'soap-encoder 'soap-encode-basic-type) | ||
| 1557 | (put (aref (make-soap-sequence-type) 0) | ||
| 1558 | 'soap-encoder 'soap-encode-sequence-type) | ||
| 1559 | (put (aref (make-soap-array-type) 0) | ||
| 1560 | 'soap-encoder 'soap-encode-array-type)) | ||
| 1561 | |||
| 1562 | (defun soap-encode-body (operation parameters wsdl) | ||
| 1563 | "Create the body of a SOAP request for OPERATION in the current buffer. | ||
| 1564 | PARAMETERS is a list of parameters supplied to the OPERATION. | ||
| 1565 | |||
| 1566 | The OPERATION and PARAMETERS are encoded according to the WSDL | ||
| 1567 | document." | ||
| 1568 | (let* ((op (soap-bound-operation-operation operation)) | ||
| 1569 | (use (soap-bound-operation-use operation)) | ||
| 1570 | (message (cdr (soap-operation-input op))) | ||
| 1571 | (parameter-order (soap-operation-parameter-order op))) | ||
| 1572 | |||
| 1573 | (unless (= (length parameter-order) (length parameters)) | ||
| 1574 | (error "Wrong number of parameters for %s: expected %d, got %s" | ||
| 1575 | (soap-element-name op) | ||
| 1576 | (length parameter-order) | ||
| 1577 | (length parameters))) | ||
| 1578 | |||
| 1579 | (insert "<soap:Body>\n") | ||
| 1580 | (when (eq use 'encoded) | ||
| 1581 | (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag op)) | ||
| 1582 | (insert "<" (soap-element-fq-name op) ">\n")) | ||
| 1583 | |||
| 1584 | (let ((param-table (loop for formal in parameter-order | ||
| 1585 | for value in parameters | ||
| 1586 | collect (cons formal value)))) | ||
| 1587 | (dolist (part (soap-message-parts message)) | ||
| 1588 | (let* ((param-name (car part)) | ||
| 1589 | (type (cdr part)) | ||
| 1590 | (tag-name (if (eq use 'encoded) | ||
| 1591 | param-name | ||
| 1592 | (soap-element-name type))) | ||
| 1593 | (value (cdr (assoc param-name param-table))) | ||
| 1594 | (start-pos (point))) | ||
| 1595 | (soap-encode-value tag-name value type) | ||
| 1596 | (when (eq use 'literal) | ||
| 1597 | ;; hack: add the xmlns attribute to the tag, the only way | ||
| 1598 | ;; ASP.NET web services recognize the namespace of the | ||
| 1599 | ;; element itself... | ||
| 1600 | (save-excursion | ||
| 1601 | (goto-char start-pos) | ||
| 1602 | (when (re-search-forward " ") | ||
| 1603 | (let* ((ns (soap-element-namespace-tag type)) | ||
| 1604 | (namespace (cdr (assoc ns | ||
| 1605 | (soap-wsdl-alias-table wsdl))))) | ||
| 1606 | (when namespace | ||
| 1607 | (insert "xmlns=\"" namespace "\" "))))))))) | ||
| 1608 | |||
| 1609 | (when (eq use 'encoded) | ||
| 1610 | (insert "</" (soap-element-fq-name op) ">\n")) | ||
| 1611 | (insert "</soap:Body>\n"))) | ||
| 1612 | |||
| 1613 | (defun soap-create-envelope (operation parameters wsdl) | ||
| 1614 | "Create a SOAP request envelope for OPERATION using PARAMETERS. | ||
| 1615 | WSDL is the wsdl document used to encode the PARAMETERS." | ||
| 1616 | (with-temp-buffer | ||
| 1617 | (let ((soap-encoded-namespaces '("xsi" "soap" "soapenc")) | ||
| 1618 | (use (soap-bound-operation-use operation))) | ||
| 1619 | |||
| 1620 | ;; Create the request body | ||
| 1621 | (soap-encode-body operation parameters wsdl) | ||
| 1622 | |||
| 1623 | ;; Put the envelope around the body | ||
| 1624 | (goto-char (point-min)) | ||
| 1625 | (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<soap:Envelope\n") | ||
| 1626 | (when (eq use 'encoded) | ||
| 1627 | (insert " soapenc:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\"\n")) | ||
| 1628 | (dolist (nstag soap-encoded-namespaces) | ||
| 1629 | (insert " xmlns:" nstag "=\"") | ||
| 1630 | (let ((nsname (cdr (assoc nstag soap-well-known-xmlns)))) | ||
| 1631 | (unless nsname | ||
| 1632 | (setq nsname (cdr (assoc nstag (soap-wsdl-alias-table wsdl))))) | ||
| 1633 | (insert nsname) | ||
| 1634 | (insert "\"\n"))) | ||
| 1635 | (insert ">\n") | ||
| 1636 | (goto-char (point-max)) | ||
| 1637 | (insert "</soap:Envelope>\n")) | ||
| 1638 | |||
| 1639 | (buffer-string))) | ||
| 1640 | |||
| 1641 | ;;;; invoking soap methods | ||
| 1642 | |||
| 1643 | (defcustom soap-debug nil | ||
| 1644 | "When t, enable some debugging facilities." | ||
| 1645 | :type 'boolean | ||
| 1646 | :group 'soap-client) | ||
| 1647 | |||
| 1648 | (defun soap-invoke (wsdl service operation-name &rest parameters) | ||
| 1649 | "Invoke a SOAP operation and return the result. | ||
| 1650 | |||
| 1651 | WSDL is used for encoding the request and decoding the response. | ||
| 1652 | It also contains information about the WEB server address that | ||
| 1653 | will service the request. | ||
| 1654 | |||
| 1655 | SERVICE is the SOAP service to invoke. | ||
| 1656 | |||
| 1657 | OPERATION-NAME is the operation to invoke. | ||
| 1658 | |||
| 1659 | PARAMETERS -- the remaining parameters are used as parameters for | ||
| 1660 | the SOAP request. | ||
| 1661 | |||
| 1662 | NOTE: The SOAP service provider should document the available | ||
| 1663 | operations and their parameters for the service. You can also | ||
| 1664 | use the `soap-inspect' function to browse the available | ||
| 1665 | operations in a WSDL document." | ||
| 1666 | (let ((port (catch 'found | ||
| 1667 | (dolist (p (soap-wsdl-ports wsdl)) | ||
| 1668 | (when (equal service (soap-element-name p)) | ||
| 1669 | (throw 'found p)))))) | ||
| 1670 | (unless port | ||
| 1671 | (error "Unknown SOAP service: %s" service)) | ||
| 1672 | |||
| 1673 | (let* ((binding (soap-port-binding port)) | ||
| 1674 | (operation (gethash operation-name | ||
| 1675 | (soap-binding-operations binding)))) | ||
| 1676 | (unless operation | ||
| 1677 | (error "No operation %s for SOAP service %s" operation-name service)) | ||
| 1678 | |||
| 1679 | (let ((url-request-method "POST") | ||
| 1680 | (url-package-name "soap-client.el") | ||
| 1681 | (url-package-version "1.0") | ||
| 1682 | (url-http-version "1.0") | ||
| 1683 | (url-request-data (soap-create-envelope operation parameters wsdl)) | ||
| 1684 | (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") | ||
| 1685 | (url-request-coding-system 'utf-8) | ||
| 1686 | (url-http-attempt-keepalives t) | ||
| 1687 | (url-request-extra-headers (list | ||
| 1688 | (cons "SOAPAction" | ||
| 1689 | (soap-bound-operation-soap-action | ||
| 1690 | operation)) | ||
| 1691 | (cons "Content-Type" | ||
| 1692 | "text/xml; charset=utf-8")))) | ||
| 1693 | (let ((buffer (url-retrieve-synchronously | ||
| 1694 | (soap-port-service-url port)))) | ||
| 1695 | (condition-case err | ||
| 1696 | (with-current-buffer buffer | ||
| 1697 | (declare (special url-http-response-status)) | ||
| 1698 | (if (null url-http-response-status) | ||
| 1699 | (error "No HTTP response from server")) | ||
| 1700 | (if (and soap-debug (> url-http-response-status 299)) | ||
| 1701 | ;; This is a warning because some SOAP errors come | ||
| 1702 | ;; back with a HTTP response 500 (internal server | ||
| 1703 | ;; error) | ||
| 1704 | (warn "Error in SOAP response: HTTP code %s" | ||
| 1705 | url-http-response-status)) | ||
| 1706 | (when (> (buffer-size) 1000000) | ||
| 1707 | (soap-warning | ||
| 1708 | "Received large message: %s bytes" | ||
| 1709 | (buffer-size))) | ||
| 1710 | (let ((mime-part (mm-dissect-buffer t t))) | ||
| 1711 | (unless mime-part | ||
| 1712 | (error "Failed to decode response from server")) | ||
| 1713 | (unless (equal (car (mm-handle-type mime-part)) "text/xml") | ||
| 1714 | (error "Server response is not an XML document")) | ||
| 1715 | (with-temp-buffer | ||
| 1716 | (mm-insert-part mime-part) | ||
| 1717 | (let ((response (car (xml-parse-region | ||
| 1718 | (point-min) (point-max))))) | ||
| 1719 | (prog1 | ||
| 1720 | (soap-parse-envelope response operation wsdl) | ||
| 1721 | (kill-buffer buffer) | ||
| 1722 | (mm-destroy-part mime-part)))))) | ||
| 1723 | (soap-error | ||
| 1724 | ;; Propagate soap-errors -- they are error replies of the | ||
| 1725 | ;; SOAP protocol and don't indicate a communication | ||
| 1726 | ;; problem or a bug in this code. | ||
| 1727 | (signal (car err) (cdr err))) | ||
| 1728 | (error | ||
| 1729 | (when soap-debug | ||
| 1730 | (pop-to-buffer buffer)) | ||
| 1731 | (error (error-message-string err))))))))) | ||
| 1732 | |||
| 1733 | (provide 'soap-client) | ||
| 1734 | |||
| 1735 | |||
| 1736 | ;;; Local Variables: | ||
| 1737 | ;;; mode: outline-minor | ||
| 1738 | ;;; outline-regexp: ";;;;+" | ||
| 1739 | ;;; End: | ||
| 1740 | |||
| 1741 | ;;; soap-client.el ends here | ||
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el new file mode 100644 index 00000000000..7cce9844d76 --- /dev/null +++ b/lisp/net/soap-inspect.el | |||
| @@ -0,0 +1,357 @@ | |||
| 1 | ;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures | ||
| 2 | |||
| 3 | ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) | ||
| 6 | ;; Created: October 2010 | ||
| 7 | ;; Keywords: soap, web-services, comm, hypermedia | ||
| 8 | ;; Homepage: http://code.google.com/p/emacs-soap-client | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | ;; | ||
| 27 | ;; This package provides an inspector for a WSDL document loaded with | ||
| 28 | ;; `soap-load-wsdl' or `soap-load-wsdl-from-url'. To use it, evaluate: | ||
| 29 | ;; | ||
| 30 | ;; (soap-inspect *wsdl*) | ||
| 31 | ;; | ||
| 32 | ;; This will pop-up the inspector buffer. You can click on ports, operations | ||
| 33 | ;; and types to explore the structure of the wsdl document. | ||
| 34 | ;; | ||
| 35 | |||
| 36 | |||
| 37 | ;;; Code: | ||
| 38 | |||
| 39 | (eval-when-compile (require 'cl)) | ||
| 40 | |||
| 41 | (require 'soap-client) | ||
| 42 | |||
| 43 | ;;; sample-value | ||
| 44 | |||
| 45 | (defun soap-sample-value (type) | ||
| 46 | "Provide a sample value for TYPE, a WSDL type. | ||
| 47 | A sample value is a LISP value which soap-client.el will accept | ||
| 48 | for encoding it using TYPE when making SOAP requests. | ||
| 49 | |||
| 50 | This is a generic function, depending on TYPE a specific function | ||
| 51 | will be called." | ||
| 52 | (let ((sample-value (get (aref type 0) 'soap-sample-value))) | ||
| 53 | (if sample-value | ||
| 54 | (funcall sample-value type) | ||
| 55 | (error "Cannot provide sample value for type %s" (aref type 0))))) | ||
| 56 | |||
| 57 | (defun soap-sample-value-for-basic-type (type) | ||
| 58 | "Provide a sample value for TYPE which is a basic type. | ||
| 59 | This is a specific function which should not be called directly, | ||
| 60 | use `soap-sample-value' instead." | ||
| 61 | (case (soap-basic-type-kind type) | ||
| 62 | (string "a string value") | ||
| 63 | (boolean t) ; could be nil as well | ||
| 64 | ((long int) (random 4200)) | ||
| 65 | ;; TODO: we need better sample values for more types. | ||
| 66 | (t (format "%s" (soap-basic-type-kind type))))) | ||
| 67 | |||
| 68 | (defun soap-sample-value-for-seqence-type (type) | ||
| 69 | "Provide a sample value for TYPE which is a sequence type. | ||
| 70 | Values for sequence types are ALISTS of (slot-name . VALUE) for | ||
| 71 | each sequence element. | ||
| 72 | |||
| 73 | This is a specific function which should not be called directly, | ||
| 74 | use `soap-sample-value' instead." | ||
| 75 | (let ((sample-value nil)) | ||
| 76 | (dolist (element (soap-sequence-type-elements type)) | ||
| 77 | (push (cons (soap-sequence-element-name element) | ||
| 78 | (soap-sample-value (soap-sequence-element-type element))) | ||
| 79 | sample-value)) | ||
| 80 | (when (soap-sequence-type-parent type) | ||
| 81 | (setq sample-value | ||
| 82 | (append (soap-sample-value (soap-sequence-type-parent type)) | ||
| 83 | sample-value))) | ||
| 84 | sample-value)) | ||
| 85 | |||
| 86 | (defun soap-sample-value-for-array-type (type) | ||
| 87 | "Provide a sample value for TYPE which is an array type. | ||
| 88 | Values for array types are LISP vectors of values which are | ||
| 89 | array's element type. | ||
| 90 | |||
| 91 | This is a specific function which should not be called directly, | ||
| 92 | use `soap-sample-value' instead." | ||
| 93 | (let* ((element-type (soap-array-type-element-type type)) | ||
| 94 | (sample1 (soap-sample-value element-type)) | ||
| 95 | (sample2 (soap-sample-value element-type))) | ||
| 96 | ;; Our sample value is a vector of two elements, but any number of | ||
| 97 | ;; elements are permissible | ||
| 98 | (vector sample1 sample2 '&etc))) | ||
| 99 | |||
| 100 | (defun soap-sample-value-for-message (message) | ||
| 101 | "Provide a sample value for a WSDL MESSAGE. | ||
| 102 | This is a specific function which should not be called directly, | ||
| 103 | use `soap-sample-value' instead." | ||
| 104 | ;; NOTE: parameter order is not considered. | ||
| 105 | (let (sample-value) | ||
| 106 | (dolist (part (soap-message-parts message)) | ||
| 107 | (push (cons (car part) | ||
| 108 | (soap-sample-value (cdr part))) | ||
| 109 | sample-value)) | ||
| 110 | (nreverse sample-value))) | ||
| 111 | |||
| 112 | (progn | ||
| 113 | ;; Install soap-sample-value methods for our types | ||
| 114 | (put (aref (make-soap-basic-type) 0) 'soap-sample-value | ||
| 115 | 'soap-sample-value-for-basic-type) | ||
| 116 | |||
| 117 | (put (aref (make-soap-sequence-type) 0) 'soap-sample-value | ||
| 118 | 'soap-sample-value-for-seqence-type) | ||
| 119 | |||
| 120 | (put (aref (make-soap-array-type) 0) 'soap-sample-value | ||
| 121 | 'soap-sample-value-for-array-type) | ||
| 122 | |||
| 123 | (put (aref (make-soap-message) 0) 'soap-sample-value | ||
| 124 | 'soap-sample-value-for-message) ) | ||
| 125 | |||
| 126 | |||
| 127 | |||
| 128 | ;;; soap-inspect | ||
| 129 | |||
| 130 | (defvar soap-inspect-previous-items nil | ||
| 131 | "A stack of previously inspected items in the *soap-inspect* buffer. | ||
| 132 | Used to implement the BACK button.") | ||
| 133 | |||
| 134 | (defvar soap-inspect-current-item nil | ||
| 135 | "The current item being inspected in the *soap-inspect* buffer.") | ||
| 136 | |||
| 137 | (progn | ||
| 138 | (make-variable-buffer-local 'soap-inspect-previous-items) | ||
| 139 | (make-variable-buffer-local 'soap-inspect-current-item)) | ||
| 140 | |||
| 141 | (defun soap-inspect (element) | ||
| 142 | "Inspect a SOAP ELEMENT in the *soap-inspect* buffer. | ||
| 143 | The buffer is populated with information about ELEMENT with links | ||
| 144 | to its sub elements. If ELEMENT is the WSDL document itself, the | ||
| 145 | entire WSDL can be inspected." | ||
| 146 | (let ((inspect (get (aref element 0) 'soap-inspect))) | ||
| 147 | (unless inspect | ||
| 148 | (error "Soap-inspect: no inspector for element")) | ||
| 149 | |||
| 150 | (with-current-buffer (get-buffer-create "*soap-inspect*") | ||
| 151 | (setq buffer-read-only t) | ||
| 152 | (let ((inhibit-read-only t)) | ||
| 153 | (erase-buffer) | ||
| 154 | |||
| 155 | (when soap-inspect-current-item | ||
| 156 | (push soap-inspect-current-item | ||
| 157 | soap-inspect-previous-items)) | ||
| 158 | (setq soap-inspect-current-item element) | ||
| 159 | |||
| 160 | (funcall inspect element) | ||
| 161 | |||
| 162 | (unless (null soap-inspect-previous-items) | ||
| 163 | (insert "\n\n") | ||
| 164 | (insert-text-button | ||
| 165 | "[back]" | ||
| 166 | 'type 'soap-client-describe-back-link | ||
| 167 | 'item element) | ||
| 168 | (insert "\n")) | ||
| 169 | (goto-char (point-min)) | ||
| 170 | (pop-to-buffer (current-buffer)))))) | ||
| 171 | |||
| 172 | |||
| 173 | (define-button-type 'soap-client-describe-link | ||
| 174 | 'face 'italic | ||
| 175 | 'help-echo "mouse-2, RET: describe item" | ||
| 176 | 'follow-link t | ||
| 177 | 'action (lambda (button) | ||
| 178 | (let ((item (button-get button 'item))) | ||
| 179 | (soap-inspect item))) | ||
| 180 | 'skip t) | ||
| 181 | |||
| 182 | (define-button-type 'soap-client-describe-back-link | ||
| 183 | 'face 'italic | ||
| 184 | 'help-echo "mouse-2, RET: browse the previous item" | ||
| 185 | 'follow-link t | ||
| 186 | 'action (lambda (button) | ||
| 187 | (let ((item (pop soap-inspect-previous-items))) | ||
| 188 | (when item | ||
| 189 | (setq soap-inspect-current-item nil) | ||
| 190 | (soap-inspect item)))) | ||
| 191 | 'skip t) | ||
| 192 | |||
| 193 | (defun soap-insert-describe-button (element) | ||
| 194 | "Insert a button to inspect ELEMENT when pressed." | ||
| 195 | (insert-text-button | ||
| 196 | (soap-element-fq-name element) | ||
| 197 | 'type 'soap-client-describe-link | ||
| 198 | 'item element)) | ||
| 199 | |||
| 200 | (defun soap-inspect-basic-type (basic-type) | ||
| 201 | "Insert information about BASIC-TYPE into the current buffer." | ||
| 202 | (insert "Basic type: " (soap-element-fq-name basic-type)) | ||
| 203 | (insert "\nSample value\n") | ||
| 204 | (pp (soap-sample-value basic-type) (current-buffer))) | ||
| 205 | |||
| 206 | (defun soap-inspect-sequence-type (sequence) | ||
| 207 | "Insert information about SEQUENCE into the current buffer." | ||
| 208 | (insert "Sequence type: " (soap-element-fq-name sequence) "\n") | ||
| 209 | (when (soap-sequence-type-parent sequence) | ||
| 210 | (insert "Parent: ") | ||
| 211 | (soap-insert-describe-button | ||
| 212 | (soap-sequence-type-parent sequence)) | ||
| 213 | (insert "\n")) | ||
| 214 | (insert "Elements: \n") | ||
| 215 | (dolist (element (soap-sequence-type-elements sequence)) | ||
| 216 | (insert "\t" (symbol-name (soap-sequence-element-name element)) | ||
| 217 | "\t") | ||
| 218 | (soap-insert-describe-button | ||
| 219 | (soap-sequence-element-type element)) | ||
| 220 | (when (soap-sequence-element-multiple? element) | ||
| 221 | (insert " multiple")) | ||
| 222 | (when (soap-sequence-element-nillable? element) | ||
| 223 | (insert " optional")) | ||
| 224 | (insert "\n")) | ||
| 225 | (insert "Sample value:\n") | ||
| 226 | (pp (soap-sample-value sequence) (current-buffer))) | ||
| 227 | |||
| 228 | (defun soap-inspect-array-type (array) | ||
| 229 | "Insert information about the ARRAY into the current buffer." | ||
| 230 | (insert "Array name: " (soap-element-fq-name array) "\n") | ||
| 231 | (insert "Element type: ") | ||
| 232 | (soap-insert-describe-button | ||
| 233 | (soap-array-type-element-type array)) | ||
| 234 | (insert "\nSample value:\n") | ||
| 235 | (pp (soap-sample-value array) (current-buffer))) | ||
| 236 | |||
| 237 | (defun soap-inspect-message (message) | ||
| 238 | "Insert information about MESSAGE into the current buffer." | ||
| 239 | (insert "Message name: " (soap-element-fq-name message) "\n") | ||
| 240 | (insert "Parts:\n") | ||
| 241 | (dolist (part (soap-message-parts message)) | ||
| 242 | (insert "\t" (symbol-name (car part)) | ||
| 243 | " type: ") | ||
| 244 | (soap-insert-describe-button (cdr part)) | ||
| 245 | (insert "\n"))) | ||
| 246 | |||
| 247 | (defun soap-inspect-operation (operation) | ||
| 248 | "Insert information about OPERATION into the current buffer." | ||
| 249 | (insert "Operation name: " (soap-element-fq-name operation) "\n") | ||
| 250 | (let ((input (soap-operation-input operation))) | ||
| 251 | (insert "\tInput: " (symbol-name (car input)) " (" ) | ||
| 252 | (soap-insert-describe-button (cdr input)) | ||
| 253 | (insert ")\n")) | ||
| 254 | (let ((output (soap-operation-output operation))) | ||
| 255 | (insert "\tOutput: " (symbol-name (car output)) " (") | ||
| 256 | (soap-insert-describe-button (cdr output)) | ||
| 257 | (insert ")\n")) | ||
| 258 | |||
| 259 | (insert "\n\nSample invocation:\n") | ||
| 260 | (let ((sample-message-value | ||
| 261 | (soap-sample-value (cdr (soap-operation-input operation)))) | ||
| 262 | (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation)))) | ||
| 263 | (let ((sample-invocation | ||
| 264 | (append funcall (mapcar 'cdr sample-message-value)))) | ||
| 265 | (pp sample-invocation (current-buffer))))) | ||
| 266 | |||
| 267 | (defun soap-inspect-port-type (port-type) | ||
| 268 | "Insert information about PORT-TYPE into the current buffer." | ||
| 269 | (insert "Port-type name: " (soap-element-fq-name port-type) "\n") | ||
| 270 | (insert "Operations:\n") | ||
| 271 | (loop for o being the hash-values of | ||
| 272 | (soap-namespace-elements (soap-port-type-operations port-type)) | ||
| 273 | do (progn | ||
| 274 | (insert "\t") | ||
| 275 | (soap-insert-describe-button (car o))))) | ||
| 276 | |||
| 277 | (defun soap-inspect-binding (binding) | ||
| 278 | "Insert information about BINDING into the current buffer." | ||
| 279 | (insert "Binding: " (soap-element-fq-name binding) "\n") | ||
| 280 | (insert "\n") | ||
| 281 | (insert "Bound operations:\n") | ||
| 282 | (let* ((ophash (soap-binding-operations binding)) | ||
| 283 | (operations (loop for o being the hash-keys of ophash | ||
| 284 | collect o)) | ||
| 285 | op-name-width) | ||
| 286 | |||
| 287 | (setq operations (sort operations 'string<)) | ||
| 288 | |||
| 289 | (setq op-name-width (loop for o in operations maximizing (length o))) | ||
| 290 | |||
| 291 | (dolist (op operations) | ||
| 292 | (let* ((bound-op (gethash op ophash)) | ||
| 293 | (soap-action (soap-bound-operation-soap-action bound-op)) | ||
| 294 | (use (soap-bound-operation-use bound-op))) | ||
| 295 | (unless soap-action | ||
| 296 | (setq soap-action "")) | ||
| 297 | (insert "\t") | ||
| 298 | (soap-insert-describe-button (soap-bound-operation-operation bound-op)) | ||
| 299 | (when (or use (not (equal soap-action ""))) | ||
| 300 | (insert (make-string (- op-name-width (length op)) ?\s)) | ||
| 301 | (insert " (") | ||
| 302 | (insert soap-action) | ||
| 303 | (when use | ||
| 304 | (insert " " (symbol-name use))) | ||
| 305 | (insert ")")) | ||
| 306 | (insert "\n"))))) | ||
| 307 | |||
| 308 | (defun soap-inspect-port (port) | ||
| 309 | "Insert information about PORT into the current buffer." | ||
| 310 | (insert "Port name: " (soap-element-name port) "\n" | ||
| 311 | "Service URL: " (soap-port-service-url port) "\n" | ||
| 312 | "Binding: ") | ||
| 313 | (soap-insert-describe-button (soap-port-binding port))) | ||
| 314 | |||
| 315 | (defun soap-inspect-wsdl (wsdl) | ||
| 316 | "Insert information about WSDL into the current buffer." | ||
| 317 | (insert "WSDL Origin: " (soap-wsdl-origin wsdl) "\n") | ||
| 318 | (insert "Ports:") | ||
| 319 | (dolist (p (soap-wsdl-ports wsdl)) | ||
| 320 | (insert "\n--------------------\n") | ||
| 321 | ;; (soap-insert-describe-button p) | ||
| 322 | (soap-inspect-port p)) | ||
| 323 | (insert "\n--------------------\nNamespace alias table:\n") | ||
| 324 | (dolist (a (soap-wsdl-alias-table wsdl)) | ||
| 325 | (insert "\t" (car a) " => " (cdr a) "\n"))) | ||
| 326 | |||
| 327 | (progn | ||
| 328 | ;; Install the soap-inspect methods for our types | ||
| 329 | |||
| 330 | (put (aref (make-soap-basic-type) 0) 'soap-inspect | ||
| 331 | 'soap-inspect-basic-type) | ||
| 332 | |||
| 333 | (put (aref (make-soap-sequence-type) 0) 'soap-inspect | ||
| 334 | 'soap-inspect-sequence-type) | ||
| 335 | |||
| 336 | (put (aref (make-soap-array-type) 0) 'soap-inspect | ||
| 337 | 'soap-inspect-array-type) | ||
| 338 | |||
| 339 | (put (aref (make-soap-message) 0) 'soap-inspect | ||
| 340 | 'soap-inspect-message) | ||
| 341 | (put (aref (make-soap-operation) 0) 'soap-inspect | ||
| 342 | 'soap-inspect-operation) | ||
| 343 | |||
| 344 | (put (aref (make-soap-port-type) 0) 'soap-inspect | ||
| 345 | 'soap-inspect-port-type) | ||
| 346 | |||
| 347 | (put (aref (make-soap-binding) 0) 'soap-inspect | ||
| 348 | 'soap-inspect-binding) | ||
| 349 | |||
| 350 | (put (aref (make-soap-port) 0) 'soap-inspect | ||
| 351 | 'soap-inspect-port) | ||
| 352 | |||
| 353 | (put (aref (make-soap-wsdl) 0) 'soap-inspect | ||
| 354 | 'soap-inspect-wsdl)) | ||
| 355 | |||
| 356 | (provide 'soap-inspect) | ||
| 357 | ;;; soap-inspect.el ends here | ||
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 5b3b4aba0fe..c60472e9386 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el | |||
| @@ -141,7 +141,7 @@ reads the sentence before point, and prints the Doctor's answer." | |||
| 141 | (turn-on-auto-fill) | 141 | (turn-on-auto-fill) |
| 142 | (doctor-type '(i am the psychotherapist \. | 142 | (doctor-type '(i am the psychotherapist \. |
| 143 | (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. | 143 | (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. |
| 144 | each time you are finished talking, type \R\E\T twice \.)) | 144 | each time you are finished talking\, type \R\E\T twice \.)) |
| 145 | (insert "\n")) | 145 | (insert "\n")) |
| 146 | 146 | ||
| 147 | (defun make-doctor-variables () | 147 | (defun make-doctor-variables () |
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index fd79cfd2399..86553f9496e 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el | |||
| @@ -5,8 +5,9 @@ | |||
| 5 | 5 | ||
| 6 | ;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com> | 6 | ;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com> |
| 7 | ;; Milan Zamazal <pdm(at)freesoft(dot)cz> | 7 | ;; Milan Zamazal <pdm(at)freesoft(dot)cz> |
| 8 | ;; Stefan Bruda <stefan(at)bruda(dot)ca> (current maintainer) | 8 | ;; Stefan Bruda <stefan(at)bruda(dot)ca> |
| 9 | ;; * See below for more details | 9 | ;; * See below for more details |
| 10 | ;; Maintainer: Stefan Bruda <stefan(at)bruda(dot)ca> | ||
| 10 | ;; Keywords: prolog major mode sicstus swi mercury | 11 | ;; Keywords: prolog major mode sicstus swi mercury |
| 11 | 12 | ||
| 12 | (defvar prolog-mode-version "1.22" | 13 | (defvar prolog-mode-version "1.22" |
diff --git a/lisp/shell.el b/lisp/shell.el index fcffc2317d5..ea89ce765c3 100644 --- a/lisp/shell.el +++ b/lisp/shell.el | |||
| @@ -151,12 +151,14 @@ This is a fine thing to set in your `.emacs' file." | |||
| 151 | :type '(repeat (string :tag "Suffix")) | 151 | :type '(repeat (string :tag "Suffix")) |
| 152 | :group 'shell) | 152 | :group 'shell) |
| 153 | 153 | ||
| 154 | (defvar shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;) | 154 | (defcustom shell-delimiter-argument-list nil ; '(?\| ?& ?< ?> ?\( ?\) ?\;) |
| 155 | "List of characters to recognize as separate arguments. | 155 | "List of characters to recognize as separate arguments. |
| 156 | This variable is used to initialize `comint-delimiter-argument-list' in the | 156 | This variable is used to initialize `comint-delimiter-argument-list' in the |
| 157 | shell buffer. The value may depend on the operating system or shell. | 157 | shell buffer. The value may depend on the operating system or shell." |
| 158 | 158 | :type '(choice (const nil) | |
| 159 | This is a fine thing to set in your `.emacs' file.") | 159 | (repeat :tag "List of characters" character)) |
| 160 | :version "24.1" ; changed to nil (bug#8027) | ||
| 161 | :group 'shell) | ||
| 160 | 162 | ||
| 161 | (defvar shell-file-name-chars | 163 | (defvar shell-file-name-chars |
| 162 | (if (memq system-type '(ms-dos windows-nt cygwin)) | 164 | (if (memq system-type '(ms-dos windows-nt cygwin)) |
diff --git a/lisp/simple.el b/lisp/simple.el index 4d2a0e69836..531c9212e34 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -778,7 +778,7 @@ If N is negative, delete newlines as well." | |||
| 778 | (n (abs n))) | 778 | (n (abs n))) |
| 779 | (skip-chars-backward skip-characters) | 779 | (skip-chars-backward skip-characters) |
| 780 | (constrain-to-field nil orig-pos) | 780 | (constrain-to-field nil orig-pos) |
| 781 | (dotimes (i (or n 1)) | 781 | (dotimes (i n) |
| 782 | (if (= (following-char) ?\s) | 782 | (if (= (following-char) ?\s) |
| 783 | (forward-char 1) | 783 | (forward-char 1) |
| 784 | (insert ?\s))) | 784 | (insert ?\s))) |
diff --git a/lisp/speedbar.el b/lisp/speedbar.el index b84afd797d1..dad2a4c82ac 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el | |||
| @@ -614,8 +614,11 @@ state data." | |||
| 614 | :group 'speedbar | 614 | :group 'speedbar |
| 615 | :type 'hook) | 615 | :type 'hook) |
| 616 | 616 | ||
| 617 | (defvar speedbar-ignored-modes '(fundamental-mode) | 617 | (defcustom speedbar-ignored-modes '(fundamental-mode) |
| 618 | "*List of major modes which speedbar will not switch directories for.") | 618 | "List of major modes which speedbar will not switch directories for." |
| 619 | :group 'speedbar | ||
| 620 | :type '(choice (const nil) | ||
| 621 | (repeat :tag "List of modes" (symbol :tag "Major mode")))) | ||
| 619 | 622 | ||
| 620 | (defun speedbar-extension-list-to-regex (extlist) | 623 | (defun speedbar-extension-list-to-regex (extlist) |
| 621 | "Takes EXTLIST, a list of extensions and transforms it into regexp. | 624 | "Takes EXTLIST, a list of extensions and transforms it into regexp. |
| @@ -669,7 +672,7 @@ directories here; see `vc-directory-exclusion-list'." | |||
| 669 | :group 'speedbar | 672 | :group 'speedbar |
| 670 | :type 'string) | 673 | :type 'string) |
| 671 | 674 | ||
| 672 | (defvar speedbar-file-unshown-regexp | 675 | (defcustom speedbar-file-unshown-regexp |
| 673 | (let ((nstr "") (noext completion-ignored-extensions)) | 676 | (let ((nstr "") (noext completion-ignored-extensions)) |
| 674 | (while noext | 677 | (while noext |
| 675 | (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" | 678 | (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" |
| @@ -677,8 +680,10 @@ directories here; see `vc-directory-exclusion-list'." | |||
| 677 | noext (cdr noext))) | 680 | noext (cdr noext))) |
| 678 | ;; backup refdir lockfile | 681 | ;; backup refdir lockfile |
| 679 | (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#")) | 682 | (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#")) |
| 680 | "*Regexp matching files we don't want displayed in a speedbar buffer. | 683 | "Regexp matching files we don't want displayed in a speedbar buffer. |
| 681 | It is generated from the variable `completion-ignored-extensions'.") | 684 | It is generated from the variable `completion-ignored-extensions'." |
| 685 | :group 'speedbar | ||
| 686 | :type 'string) | ||
| 682 | 687 | ||
| 683 | (defvar speedbar-file-regexp nil | 688 | (defvar speedbar-file-regexp nil |
| 684 | "Regular expression matching files we know how to expand. | 689 | "Regular expression matching files we know how to expand. |
| @@ -755,14 +760,17 @@ DIRECTORY-EXPRESSION to `speedbar-ignored-directory-expressions'." | |||
| 755 | speedbar-ignored-directory-regexp (speedbar-extension-list-to-regex | 760 | speedbar-ignored-directory-regexp (speedbar-extension-list-to-regex |
| 756 | speedbar-ignored-directory-expressions))) | 761 | speedbar-ignored-directory-expressions))) |
| 757 | 762 | ||
| 758 | (defvar speedbar-update-flag dframe-have-timer-flag | 763 | (defcustom speedbar-update-flag dframe-have-timer-flag |
| 759 | "*Non-nil means to automatically update the display. | 764 | "Non-nil means to automatically update the display. |
| 760 | When this is nil then speedbar will not follow the attached frame's directory. | 765 | When this is nil then speedbar will not follow the attached frame's directory. |
| 761 | When speedbar is active, use: | 766 | If you want to change this while speedbar is active, either use |
| 762 | 767 | \\[customize] or call \\<speedbar-key-map> `\\[speedbar-toggle-updates]'." | |
| 763 | \\<speedbar-key-map> `\\[speedbar-toggle-updates]' | 768 | :group 'speedbar |
| 764 | 769 | :initialize 'custom-initialize-default | |
| 765 | to toggle this value.") | 770 | :set (lambda (sym val) |
| 771 | (set sym val) | ||
| 772 | (speedbar-toggle-updates)) | ||
| 773 | :type 'boolean) | ||
| 766 | 774 | ||
| 767 | (defvar speedbar-update-flag-disable nil | 775 | (defvar speedbar-update-flag-disable nil |
| 768 | "Permanently disable changing of the update flag.") | 776 | "Permanently disable changing of the update flag.") |
| @@ -3643,17 +3651,20 @@ to be at the beginning of a line in the etags buffer. | |||
| 3643 | 3651 | ||
| 3644 | This variable is ignored if `speedbar-use-imenu-flag' is non-nil.") | 3652 | This variable is ignored if `speedbar-use-imenu-flag' is non-nil.") |
| 3645 | 3653 | ||
| 3646 | (defvar speedbar-fetch-etags-command "etags" | 3654 | (defcustom speedbar-fetch-etags-command "etags" |
| 3647 | "*Command used to create an etags file. | 3655 | "Command used to create an etags file. |
| 3648 | 3656 | This variable is ignored if `speedbar-use-imenu-flag' is t." | |
| 3649 | This variable is ignored if `speedbar-use-imenu-flag' is t.") | 3657 | :group 'speedbar |
| 3658 | :type 'string) | ||
| 3650 | 3659 | ||
| 3651 | (defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") | 3660 | (defcustom speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") |
| 3652 | "*List of arguments to use with `speedbar-fetch-etags-command'. | 3661 | "List of arguments to use with `speedbar-fetch-etags-command'. |
| 3653 | This creates an etags output buffer. Use `speedbar-toggle-etags' to | 3662 | This creates an etags output buffer. Use `speedbar-toggle-etags' to |
| 3654 | modify this list conveniently. | 3663 | modify this list conveniently. |
| 3655 | 3664 | This variable is ignored if `speedbar-use-imenu-flag' is t." | |
| 3656 | This variable is ignored if `speedbar-use-imenu-flag' is t.") | 3665 | :group 'speedbar |
| 3666 | :type '(choice (const nil) | ||
| 3667 | (repeat :tag "List of arguments" string))) | ||
| 3657 | 3668 | ||
| 3658 | (defun speedbar-toggle-etags (flag) | 3669 | (defun speedbar-toggle-etags (flag) |
| 3659 | "Toggle FLAG in `speedbar-fetch-etags-arguments'. | 3670 | "Toggle FLAG in `speedbar-fetch-etags-arguments'. |
diff --git a/lisp/term.el b/lisp/term.el index ea419234e0f..df95ca830ab 100644 --- a/lisp/term.el +++ b/lisp/term.el | |||
| @@ -762,11 +762,13 @@ Buffer local variable.") | |||
| 762 | "magenta3" "cyan3" "white"]) | 762 | "magenta3" "cyan3" "white"]) |
| 763 | 763 | ||
| 764 | ;; Inspiration came from comint.el -mm | 764 | ;; Inspiration came from comint.el -mm |
| 765 | (defvar term-buffer-maximum-size 2048 | 765 | (defcustom term-buffer-maximum-size 2048 |
| 766 | "*The maximum size in lines for term buffers. | 766 | "The maximum size in lines for term buffers. |
| 767 | Term buffers are truncated from the top to be no greater than this number. | 767 | Term buffers are truncated from the top to be no greater than this number. |
| 768 | Notice that a setting of 0 means \"don't truncate anything\". This variable | 768 | Notice that a setting of 0 means \"don't truncate anything\". This variable |
| 769 | is buffer-local.") | 769 | is buffer-local." |
| 770 | :group 'term | ||
| 771 | :type 'integer) | ||
| 770 | 772 | ||
| 771 | (when (featurep 'xemacs) | 773 | (when (featurep 'xemacs) |
| 772 | (defvar term-terminal-menu | 774 | (defvar term-terminal-menu |
| @@ -2209,9 +2211,11 @@ Security bug: your string can still be temporarily recovered with | |||
| 2209 | 2211 | ||
| 2210 | ;;; Low-level process communication | 2212 | ;;; Low-level process communication |
| 2211 | 2213 | ||
| 2212 | (defvar term-input-chunk-size 512 | 2214 | (defcustom term-input-chunk-size 512 |
| 2213 | "*Long inputs send to term processes are broken up into chunks of this size. | 2215 | "Long inputs send to term processes are broken up into chunks of this size. |
| 2214 | If your process is choking on big inputs, try lowering the value.") | 2216 | If your process is choking on big inputs, try lowering the value." |
| 2217 | :group 'term | ||
| 2218 | :type 'integer) | ||
| 2215 | 2219 | ||
| 2216 | (defun term-send-string (proc str) | 2220 | (defun term-send-string (proc str) |
| 2217 | "Send to PROC the contents of STR as input. | 2221 | "Send to PROC the contents of STR as input. |
| @@ -3909,27 +3913,38 @@ This is a good place to put keybindings.") | |||
| 3909 | ;; Commands like this are fine things to put in load hooks if you | 3913 | ;; Commands like this are fine things to put in load hooks if you |
| 3910 | ;; want them present in specific modes. | 3914 | ;; want them present in specific modes. |
| 3911 | 3915 | ||
| 3912 | (defvar term-completion-autolist nil | 3916 | (defcustom term-completion-autolist nil |
| 3913 | "*If non-nil, automatically list possibilities on partial completion. | 3917 | "If non-nil, automatically list possibilities on partial completion. |
| 3914 | This mirrors the optional behavior of tcsh.") | 3918 | This mirrors the optional behavior of tcsh." |
| 3919 | :group 'term | ||
| 3920 | :type 'boolean) | ||
| 3915 | 3921 | ||
| 3916 | (defvar term-completion-addsuffix t | 3922 | (defcustom term-completion-addsuffix t |
| 3917 | "*If non-nil, add a `/' to completed directories, ` ' to file names. | 3923 | "If non-nil, add a `/' to completed directories, ` ' to file names. |
| 3918 | If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where | 3924 | If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where |
| 3919 | DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact | 3925 | DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact |
| 3920 | completion. This mirrors the optional behavior of tcsh.") | 3926 | completion. This mirrors the optional behavior of tcsh." |
| 3927 | :group 'term | ||
| 3928 | :type '(choice (const :tag "No suffix" nil) | ||
| 3929 | (cons (string :tag "dirsuffix") (string :tag "filesuffix")) | ||
| 3930 | (other :tag "Suffix" t))) | ||
| 3921 | 3931 | ||
| 3922 | (defvar term-completion-recexact nil | 3932 | (defcustom term-completion-recexact nil |
| 3923 | "*If non-nil, use shortest completion if characters cannot be added. | 3933 | "If non-nil, use shortest completion if characters cannot be added. |
| 3924 | This mirrors the optional behavior of tcsh. | 3934 | This mirrors the optional behavior of tcsh. |
| 3925 | 3935 | ||
| 3926 | A non-nil value is useful if `term-completion-autolist' is non-nil too.") | 3936 | A non-nil value is useful if `term-completion-autolist' is non-nil too." |
| 3937 | :group 'term | ||
| 3938 | :type 'boolean) | ||
| 3927 | 3939 | ||
| 3928 | (defvar term-completion-fignore nil | 3940 | (defcustom term-completion-fignore nil |
| 3929 | "*List of suffixes to be disregarded during file completion. | 3941 | "List of suffixes to be disregarded during file completion. |
| 3930 | This mirrors the optional behavior of bash and tcsh. | 3942 | This mirrors the optional behavior of bash and tcsh. |
| 3931 | 3943 | ||
| 3932 | Note that this applies to `term-dynamic-complete-filename' only.") | 3944 | Note that this applies to `term-dynamic-complete-filename' only." |
| 3945 | :group 'term | ||
| 3946 | :type '(choice (const nil) | ||
| 3947 | (repeat :tag "List of suffixes" string))) | ||
| 3933 | 3948 | ||
| 3934 | (defvar term-file-name-prefix "" | 3949 | (defvar term-file-name-prefix "" |
| 3935 | "Prefix prepended to absolute file names taken from process input. | 3950 | "Prefix prepended to absolute file names taken from process input. |
diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el index a8b78bb3e38..6d77241008c 100644 --- a/lisp/term/sup-mouse.el +++ b/lisp/term/sup-mouse.el | |||
| @@ -30,8 +30,11 @@ | |||
| 30 | 30 | ||
| 31 | ;;; User customization option: | 31 | ;;; User customization option: |
| 32 | 32 | ||
| 33 | (defvar sup-mouse-fast-select-window nil | 33 | (defcustom sup-mouse-fast-select-window nil |
| 34 | "*Non-nil for mouse hits to select new window, then execute; else just select.") | 34 | "Non-nil means mouse hits select new window, then execute. |
| 35 | Otherwise just select." | ||
| 36 | :type 'boolean | ||
| 37 | :group 'mouse) | ||
| 35 | 38 | ||
| 36 | (defconst mouse-left 0) | 39 | (defconst mouse-left 0) |
| 37 | (defconst mouse-center 1) | 40 | (defconst mouse-center 1) |
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 1ec80d5c277..e3c42626a3f 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el | |||
| @@ -1167,20 +1167,28 @@ pasted text.") | |||
| 1167 | :group 'killing | 1167 | :group 'killing |
| 1168 | :version "24.1") | 1168 | :version "24.1") |
| 1169 | 1169 | ||
| 1170 | (defvar x-select-request-type nil | 1170 | (defcustom x-select-request-type nil |
| 1171 | "*Data type request for X selection. | 1171 | "Data type request for X selection. |
| 1172 | The value is one of the following data types, a list of them, or nil: | 1172 | The value is one of the following data types, a list of them, or nil: |
| 1173 | `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' | 1173 | `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' |
| 1174 | 1174 | ||
| 1175 | If the value is one of the above symbols, try only the specified | 1175 | If the value is one of the above symbols, try only the specified type. |
| 1176 | type. | ||
| 1177 | 1176 | ||
| 1178 | If the value is a list of them, try each of them in the specified | 1177 | If the value is a list of them, try each of them in the specified |
| 1179 | order until succeed. | 1178 | order until succeed. |
| 1180 | 1179 | ||
| 1181 | The value nil is the same as this list: | 1180 | The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." |
| 1182 | \(UTF8_STRING COMPOUND_TEXT STRING) | 1181 | :type '(choice (const :tag "Default" nil) |
| 1183 | ") | 1182 | (const COMPOUND_TEXT) |
| 1183 | (const UTF8_STRING) | ||
| 1184 | (const STRING) | ||
| 1185 | (const TEXT) | ||
| 1186 | (set :tag "List of values" | ||
| 1187 | (const COMPOUND_TEXT) | ||
| 1188 | (const UTF8_STRING) | ||
| 1189 | (const STRING) | ||
| 1190 | (const TEXT))) | ||
| 1191 | :group 'killing) | ||
| 1184 | 1192 | ||
| 1185 | ;; Get a selection value of type TYPE by calling x-get-selection with | 1193 | ;; Get a selection value of type TYPE by calling x-get-selection with |
| 1186 | ;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. | 1194 | ;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. |
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 815bdbfc5bf..02743847800 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el | |||
| @@ -2614,9 +2614,6 @@ log entries should be gathered." | |||
| 2614 | (when index | 2614 | (when index |
| 2615 | (substring rev 0 index)))) | 2615 | (substring rev 0 index)))) |
| 2616 | 2616 | ||
| 2617 | (define-obsolete-function-alias | ||
| 2618 | 'vc-default-previous-version 'vc-default-previous-revision "23.1") | ||
| 2619 | |||
| 2620 | (defun vc-default-responsible-p (backend file) | 2617 | (defun vc-default-responsible-p (backend file) |
| 2621 | "Indicate whether BACKEND is reponsible for FILE. | 2618 | "Indicate whether BACKEND is reponsible for FILE. |
| 2622 | The default is to return nil always." | 2619 | The default is to return nil always." |
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index 4aae158e963..e58d29b238f 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 | |||
| @@ -26,6 +26,8 @@ test -f "$srcdir/$1/getloadavg.c" || | |||
| 26 | 26 | ||
| 27 | gl_save_LIBS=$LIBS | 27 | gl_save_LIBS=$LIBS |
| 28 | 28 | ||
| 29 | # getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, | ||
| 30 | # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. | ||
| 29 | AC_CHECK_FUNC([getloadavg], [], | 31 | AC_CHECK_FUNC([getloadavg], [], |
| 30 | [gl_have_func=no | 32 | [gl_have_func=no |
| 31 | 33 | ||
diff --git a/src/ChangeLog b/src/ChangeLog index 87649d3db20..356637b0709 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,241 @@ | |||
| 1 | 2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * lisp.h (BYTE_MARK_STACK): New macro. | ||
| 4 | (mark_byte_stack): Only declare if BYTE_MARK_STACK is set. | ||
| 5 | |||
| 6 | * bytecode.c (BYTE_MAINTAIN_TOP): New macros. | ||
| 7 | (struct byte_stack): Only define `top' and `bottom' if used. | ||
| 8 | (mark_byte_stack): Only define if used. | ||
| 9 | (BEFORE_POTENTIAL_GC, AFTER_POTENTIAL_GC): Nullify if BYTE_MAINTAIN_TOP | ||
| 10 | is not set. | ||
| 11 | (Fbyte_code): Don't set `bottom' unless BYTE_MAINTAIN_TOP is set. | ||
| 12 | |||
| 13 | * term.c (OUTPUT_IF): Use OUTPUT. | ||
| 14 | |||
| 15 | * alloc.c (Fgarbage_collect): When using stack scanning, don't | ||
| 16 | redundantly scan byte-code stacks, catchlist, and handlerlist. | ||
| 17 | |||
| 18 | 2011-02-17 Jan Djärv <jan.h.d@swipnet.se> | ||
| 19 | |||
| 20 | * nsfns.m (Fx_create_frame, ns_set_name_as_filename) | ||
| 21 | (Fns_read_file_name): Replace B_ with BVAR. | ||
| 22 | |||
| 23 | * nsterm.m (ns_term_init): Use KVAR. | ||
| 24 | |||
| 25 | 2011-02-16 Eli Zaretskii <eliz@gnu.org> | ||
| 26 | |||
| 27 | * msdos.c (internal_terminal_init): Use KVAR. | ||
| 28 | |||
| 29 | * w32fns.c (Fx_create_frame): Use KVAR. | ||
| 30 | |||
| 31 | * w32term.c (w32_create_terminal): Use KVAR. | ||
| 32 | |||
| 33 | * s/ms-w32.h (MODE_LINE_BINARY_TEXT): Remove. | ||
| 34 | (getloadavg): Declare prototype which was removed from lisp.h. | ||
| 35 | |||
| 36 | * xdisp.c (decode_mode_spec): Don't use MODE_LINE_BINARY_TEXT. | ||
| 37 | |||
| 38 | * fileio.c (Finsert_file_contents, Fwrite_region): | ||
| 39 | Remove references to buffer_file_type. | ||
| 40 | (syms_of_fileio): Don't intern and staticpro | ||
| 41 | find-buffer-file-type. | ||
| 42 | |||
| 43 | * callproc.c (syms_of_callproc): Remove references to | ||
| 44 | buffer_file_type. | ||
| 45 | |||
| 46 | * buffer.c (reset_buffer_local_variables): Don't set | ||
| 47 | buffer_file_type. | ||
| 48 | (init_buffer_once): Likewise. | ||
| 49 | (syms_of_buffer): Don't define buffer-file-type. | ||
| 50 | |||
| 51 | * buffer.h (struct buffer): Remove buffer_file_type. | ||
| 52 | |||
| 53 | 2011-02-16 Tom Tromey <tromey@parfait> | ||
| 54 | |||
| 55 | * callint.c (Fcall_interactively): Update for change to field names. | ||
| 56 | * doc.c (Fsubstitute_command_keys): Update for change to field names. | ||
| 57 | * cmds.c (Fself_insert_command): Update for change to field names. | ||
| 58 | * keymap.c (Fcurrent_active_maps, Fkey_binding) | ||
| 59 | (Fdescribe_buffer_bindings): Update for change to field names. | ||
| 60 | * macros.c (Fstart_kbd_macro, end_kbd_macro, Fend_kbd_macro) | ||
| 61 | (store_kbd_macro_char, Fcall_last_kbd_macro, Fexecute_kbd_macro): | ||
| 62 | Update for change to field names. | ||
| 63 | * keyboard.c (echo_char, echo_dash, echo_now, cancel_echoing) | ||
| 64 | (echo_length, echo_truncate, cmd_error, command_loop_1) | ||
| 65 | (read_char, kbd_buffer_store_event_hold, make_lispy_event) | ||
| 66 | (menu_bar_items, tool_bar_items, read_char_minibuf_menu_prompt) | ||
| 67 | (read_key_sequence, Fcommand_execute, Fexecute_extended_command) | ||
| 68 | (Fdiscard_input, init_kboard, init_keyboard, mark_kboards): | ||
| 69 | Update for change to field names. | ||
| 70 | * xfns.c (Fx_create_frame): Update for change to field names. | ||
| 71 | * xterm.c (x_connection_closed, x_term_init): Update for change to | ||
| 72 | field names. | ||
| 73 | * term.c (term_get_fkeys_1, CONDITIONAL_REASSIGN, init_tty): | ||
| 74 | Update for change to field names. | ||
| 75 | * window.c (window_scroll_pixel_based, window_scroll_line_based): | ||
| 76 | Update for change to field names. | ||
| 77 | * frame.c (make_frame_without_minibuffer, Fhandle_switch_frame) | ||
| 78 | (delete_frame): Update for change to field names. | ||
| 79 | * lisp.h (DEFVAR_KBOARD): Update for change to field names. | ||
| 80 | * keyboard.h (struct kboard): Rename all Lisp_Object fields. | ||
| 81 | (KBOARD_INTERNAL_FIELD, KVAR): New macros. | ||
| 82 | |||
| 83 | 2011-02-16 Tom Tromey <tromey@redhat.com> | ||
| 84 | |||
| 85 | * lisp.h (DEFVAR_BUFFER_DEFAULTS): Use BVAR. | ||
| 86 | |||
| 87 | 2011-02-16 Tom Tromey <tromey@parfait> | ||
| 88 | |||
| 89 | * xfns.c (x_create_tip_frame, Fx_show_tip): Replace B_ with BVAR. | ||
| 90 | * xfaces.c (compute_char_face): Replace B_ with BVAR. | ||
| 91 | * xdisp.c (pos_visible_p, init_iterator, reseat_1) | ||
| 92 | (message_dolog, update_echo_area, ensure_echo_area_buffers) | ||
| 93 | (with_echo_area_buffer, setup_echo_area_for_printing) | ||
| 94 | (set_message_1, update_menu_bar, update_tool_bar) | ||
| 95 | (text_outside_line_unchanged_p, redisplay_internal) | ||
| 96 | (try_scrolling, try_cursor_movement, redisplay_window) | ||
| 97 | (try_window_reusing_current_matrix, row_containing_pos) | ||
| 98 | (try_window_id, get_overlay_arrow_glyph_row, display_line) | ||
| 99 | (Fcurrent_bidi_paragraph_direction, display_mode_lines) | ||
| 100 | (decode_mode_spec_coding, decode_mode_spec, display_count_lines) | ||
| 101 | (get_window_cursor_type, note_mouse_highlight): Replace B_ with | ||
| 102 | BVAR. | ||
| 103 | * window.c (window_display_table, unshow_buffer, window_loop) | ||
| 104 | (window_min_size_2, set_window_buffer, Fset_window_buffer) | ||
| 105 | (select_window, Fforce_window_update, temp_output_buffer_show) | ||
| 106 | (Fset_window_configuration, save_window_save): Replace B_ with | ||
| 107 | BVAR. | ||
| 108 | * w32fns.c (x_create_tip_frame, Fx_show_tip, Fw32_shell_execute): | ||
| 109 | Replace B_ with BVAR. | ||
| 110 | * undo.c (record_point, record_insert, record_delete) | ||
| 111 | (record_marker_adjustment, record_first_change) | ||
| 112 | (record_property_change, Fundo_boundary, truncate_undo_list) | ||
| 113 | (Fprimitive_undo): Replace B_ with BVAR. | ||
| 114 | * syntax.h (Vstandard_syntax_table, CURRENT_SYNTAX_TABLE) | ||
| 115 | (SETUP_BUFFER_SYNTAX_TABLE): Replace B_ with BVAR. | ||
| 116 | * syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table) | ||
| 117 | (Fset_syntax_table, Fmodify_syntax_entry, skip_chars) | ||
| 118 | (skip_syntaxes, scan_lists): Replace B_ with BVAR. | ||
| 119 | * search.c (compile_pattern_1, compile_pattern, looking_at_1) | ||
| 120 | (string_match_1, fast_looking_at, newline_cache_on_off) | ||
| 121 | (search_command, search_buffer, simple_search, boyer_moore) | ||
| 122 | (Freplace_match): Replace B_ with BVAR. | ||
| 123 | * process.c (get_process, list_processes_1, Fstart_process) | ||
| 124 | (Fmake_serial_process, Fmake_network_process) | ||
| 125 | (read_process_output, send_process, exec_sentinel) | ||
| 126 | (status_notify, setup_process_coding_systems): Replace B_ with | ||
| 127 | BVAR. | ||
| 128 | * print.c (PRINTDECLARE, PRINTPREPARE, PRINTFINISH, printchar) | ||
| 129 | (strout, print_string, temp_output_buffer_setup, print_object): | ||
| 130 | Replace B_ with BVAR. | ||
| 131 | * msdos.c (IT_frame_up_to_date): Replace B_ with BVAR. | ||
| 132 | * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): | ||
| 133 | Replace B_ with BVAR. | ||
| 134 | * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) | ||
| 135 | (set_marker_both, set_marker_restricted_both, unchain_marker): | ||
| 136 | Replace B_ with BVAR. | ||
| 137 | * lread.c (readchar, unreadchar, openp, readevalloop) | ||
| 138 | (Feval_buffer, Feval_region): Replace B_ with BVAR. | ||
| 139 | * lisp.h (DOWNCASE_TABLE, UPCASE_TABLE): Replace B_ with BVAR. | ||
| 140 | * keymap.c (Flocal_key_binding, Fuse_local_map) | ||
| 141 | (Fcurrent_local_map, push_key_description) | ||
| 142 | (Fdescribe_buffer_bindings): Replace B_ with BVAR. | ||
| 143 | * keyboard.c (command_loop_1, read_char_minibuf_menu_prompt) | ||
| 144 | (read_key_sequence): Replace B_ with BVAR. | ||
| 145 | * intervals.h (TEXT_PROP_MEANS_INVISIBLE): Replace B_ with BVAR. | ||
| 146 | * intervals.c (set_point_both, get_local_map): Replace B_ with | ||
| 147 | BVAR. | ||
| 148 | * insdel.c (check_markers, insert_char, insert_1_both) | ||
| 149 | (insert_from_string_1, insert_from_gap, insert_from_buffer_1) | ||
| 150 | (adjust_after_replace, replace_range, del_range_2) | ||
| 151 | (modify_region, prepare_to_modify_buffer) | ||
| 152 | (Fcombine_after_change_execute): Replace B_ with BVAR. | ||
| 153 | * indent.c (buffer_display_table, recompute_width_table) | ||
| 154 | (width_run_cache_on_off, current_column, scan_for_column) | ||
| 155 | (Findent_to, position_indentation, compute_motion, vmotion): | ||
| 156 | Replace B_ with BVAR. | ||
| 157 | * fringe.c (get_logical_cursor_bitmap) | ||
| 158 | (get_logical_fringe_bitmap, update_window_fringes): Replace B_ | ||
| 159 | with BVAR. | ||
| 160 | * frame.c (make_frame_visible_1): Replace B_ with BVAR. | ||
| 161 | * font.c (font_at): Replace B_ with BVAR. | ||
| 162 | * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): | ||
| 163 | Replace B_ with BVAR. | ||
| 164 | * filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer) | ||
| 165 | (unlock_buffer): Replace B_ with BVAR. | ||
| 166 | * fileio.c (Fexpand_file_name, Ffile_directory_p) | ||
| 167 | (Ffile_regular_p, Ffile_selinux_context) | ||
| 168 | (Fset_file_selinux_context, Ffile_modes, Fset_file_modes) | ||
| 169 | (Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind) | ||
| 170 | (Finsert_file_contents, choose_write_coding_system) | ||
| 171 | (Fwrite_region, build_annotations, Fverify_visited_file_modtime) | ||
| 172 | (Fset_visited_file_modtime, auto_save_error, auto_save_1) | ||
| 173 | (Fdo_auto_save, Fset_buffer_auto_saved): Replace B_ with BVAR. | ||
| 174 | * editfns.c (region_limit, Fmark_marker, save_excursion_save) | ||
| 175 | (save_excursion_restore, Fprevious_char, Fchar_before) | ||
| 176 | (general_insert_function, Finsert_char, Finsert_byte) | ||
| 177 | (make_buffer_string_both, Finsert_buffer_substring) | ||
| 178 | (Fcompare_buffer_substrings, subst_char_in_region_unwind) | ||
| 179 | (subst_char_in_region_unwind_1, Fsubst_char_in_region) | ||
| 180 | (Ftranslate_region_internal, save_restriction_restore) | ||
| 181 | (Fchar_equal): Replace B_ with BVAR. | ||
| 182 | * dispnew.c (Fframe_or_buffer_changed_p): Replace B_ with BVAR. | ||
| 183 | * dispextern.h (WINDOW_WANTS_MODELINE_P) | ||
| 184 | (WINDOW_WANTS_HEADER_LINE_P): Replace B_ with BVAR. | ||
| 185 | * dired.c (directory_files_internal): Replace B_ with BVAR. | ||
| 186 | * data.c (swap_in_symval_forwarding, set_internal) | ||
| 187 | (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p): | ||
| 188 | Replace B_ with BVAR. | ||
| 189 | * composite.c (fill_gstring_header) | ||
| 190 | (composition_compute_stop_pos, composition_adjust_point) | ||
| 191 | (Ffind_composition_internal): Replace B_ with BVAR. | ||
| 192 | * coding.c (decode_coding, encode_coding) | ||
| 193 | (make_conversion_work_buffer, decode_coding_gap) | ||
| 194 | (decode_coding_object, encode_coding_object) | ||
| 195 | (Fdetect_coding_region, Ffind_coding_systems_region_internal) | ||
| 196 | (Funencodable_char_position, Fcheck_coding_systems_region): | ||
| 197 | Replace B_ with BVAR. | ||
| 198 | * cmds.c (Fself_insert_command, internal_self_insert): Replace B_ | ||
| 199 | with BVAR. | ||
| 200 | * charset.c (Ffind_charset_region): Replace B_ with BVAR. | ||
| 201 | * character.h (FETCH_CHAR_ADVANCE, INC_BOTH, DEC_BOTH) | ||
| 202 | (ASCII_CHAR_WIDTH): Replace B_ with BVAR. | ||
| 203 | * character.c (chars_in_text, Fget_byte): Replace B_ with BVAR. | ||
| 204 | * category.h (Vstandard_category_table): Replace B_ with BVAR. | ||
| 205 | * category.c (check_category_table, Fcategory_table) | ||
| 206 | (Fset_category_table, char_category_set): Replace B_ with BVAR. | ||
| 207 | * casetab.c (Fcurrent_case_table, set_case_table): Replace B_ with | ||
| 208 | BVAR. | ||
| 209 | * casefiddle.c (casify_object, casify_region): Replace B_ with | ||
| 210 | BVAR. | ||
| 211 | * callproc.c (Fcall_process, Fcall_process_region): Replace B_ | ||
| 212 | with BVAR. | ||
| 213 | * callint.c (check_mark, Fcall_interactively): Replace B_ with | ||
| 214 | BVAR. | ||
| 215 | * bytecode.c (Fbyte_code): Replace B_ with BVAR. | ||
| 216 | * buffer.h (FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE, BVAR): Replace B_ | ||
| 217 | with BVAR. | ||
| 218 | * buffer.c (Fbuffer_live_p, Fget_file_buffer) | ||
| 219 | (get_truename_buffer, Fget_buffer_create) | ||
| 220 | (clone_per_buffer_values, Fmake_indirect_buffer, reset_buffer) | ||
| 221 | (reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name) | ||
| 222 | (Fbuffer_local_value, buffer_lisp_local_variables) | ||
| 223 | (Fset_buffer_modified_p, Frestore_buffer_modified_p) | ||
| 224 | (Frename_buffer, Fother_buffer, Fbuffer_enable_undo) | ||
| 225 | (Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1) | ||
| 226 | (set_buffer_temp, Fset_buffer, set_buffer_if_live) | ||
| 227 | (Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer) | ||
| 228 | (Fbuffer_swap_text, swapfield_, Fbuffer_swap_text) | ||
| 229 | (Fset_buffer_multibyte, swap_out_buffer_local_variables) | ||
| 230 | (record_overlay_string, overlay_strings, init_buffer_once) | ||
| 231 | (init_buffer, syms_of_buffer): Replace B_ with BVAR. | ||
| 232 | |||
| 233 | 2011-02-16 Eli Zaretskii <eliz@gnu.org> | ||
| 234 | |||
| 235 | * xdisp.c (redisplay_internal): Resynchronize `w' if the selected | ||
| 236 | window is changed inside calls to do_pending_window_change. | ||
| 237 | (Bug#8020) | ||
| 238 | |||
| 1 | 2011-02-16 Paul Eggert <eggert@cs.ucla.edu> | 239 | 2011-02-16 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 240 | ||
| 3 | Remove no-longer needed getloadavg symbols. | 241 | Remove no-longer needed getloadavg symbols. |
| @@ -54,8 +292,8 @@ | |||
| 54 | * xmenu.c (apply_systemfont_to_dialog): Apply to *dialog.font. | 292 | * xmenu.c (apply_systemfont_to_dialog): Apply to *dialog.font. |
| 55 | (apply_systemfont_to_menu): Set resources *menubar*font and | 293 | (apply_systemfont_to_menu): Set resources *menubar*font and |
| 56 | *popup*font. Remove defflt. | 294 | *popup*font. Remove defflt. |
| 57 | (set_frame_menubar, create_and_show_popup_menu): Call | 295 | (set_frame_menubar, create_and_show_popup_menu): |
| 58 | apply_systemfont_to_menu before lw_create_widget. | 296 | Call apply_systemfont_to_menu before lw_create_widget. |
| 59 | 297 | ||
| 60 | 2011-02-14 Tom Tromey <tromey@redhat.com> | 298 | 2011-02-14 Tom Tromey <tromey@redhat.com> |
| 61 | 299 | ||
| @@ -84,8 +322,8 @@ | |||
| 84 | (PRINTPREPARE, PRINTFINISH, temp_output_buffer_setup) | 322 | (PRINTPREPARE, PRINTFINISH, temp_output_buffer_setup) |
| 85 | (print_object): Use B_. | 323 | (print_object): Use B_. |
| 86 | * font.c (font_at): Use B_. | 324 | * font.c (font_at): Use B_. |
| 87 | * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): Use | 325 | * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): |
| 88 | B_. | 326 | Use B_. |
| 89 | * callint.c (check_mark, Fcall_interactively): Use B_. | 327 | * callint.c (check_mark, Fcall_interactively): Use B_. |
| 90 | * editfns.c (region_limit, Fmark_marker, save_excursion_save) | 328 | * editfns.c (region_limit, Fmark_marker, save_excursion_save) |
| 91 | (save_excursion_restore, Fprevious_char, Fchar_before) | 329 | (save_excursion_restore, Fprevious_char, Fchar_before) |
| @@ -108,8 +346,8 @@ | |||
| 108 | (Freplace_match): Use B_. | 346 | (Freplace_match): Use B_. |
| 109 | * indent.c (buffer_display_table, recompute_width_table) | 347 | * indent.c (buffer_display_table, recompute_width_table) |
| 110 | (width_run_cache_on_off, current_column, scan_for_column) | 348 | (width_run_cache_on_off, current_column, scan_for_column) |
| 111 | (Findent_to, position_indentation, compute_motion, vmotion): Use | 349 | (Findent_to, position_indentation, compute_motion, vmotion): |
| 112 | B_. | 350 | Use B_. |
| 113 | * casefiddle.c (casify_object, casify_region): Use B_. | 351 | * casefiddle.c (casify_object, casify_region): Use B_. |
| 114 | * casetab.c (Fcurrent_case_table, set_case_table): Use B_. | 352 | * casetab.c (Fcurrent_case_table, set_case_table): Use B_. |
| 115 | * cmds.c (Fself_insert_command, internal_self_insert): Use B_. | 353 | * cmds.c (Fself_insert_command, internal_self_insert): Use B_. |
| @@ -123,8 +361,8 @@ | |||
| 123 | (Fdo_auto_save, Fset_buffer_auto_saved): Use B_. | 361 | (Fdo_auto_save, Fset_buffer_auto_saved): Use B_. |
| 124 | * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Use B_. | 362 | * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Use B_. |
| 125 | * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) | 363 | * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) |
| 126 | (set_marker_both, set_marker_restricted_both, unchain_marker): Use | 364 | (set_marker_both, set_marker_restricted_both, unchain_marker): |
| 127 | B_. | 365 | Use B_. |
| 128 | * insdel.c (check_markers, insert_char, insert_1_both) | 366 | * insdel.c (check_markers, insert_char, insert_1_both) |
| 129 | (insert_from_string_1, insert_from_gap, insert_from_buffer_1) | 367 | (insert_from_string_1, insert_from_gap, insert_from_buffer_1) |
| 130 | (adjust_after_replace, replace_range, del_range_2) | 368 | (adjust_after_replace, replace_range, del_range_2) |
| @@ -148,8 +386,8 @@ | |||
| 148 | (make_conversion_work_buffer, decode_coding_gap) | 386 | (make_conversion_work_buffer, decode_coding_gap) |
| 149 | (decode_coding_object, encode_coding_object) | 387 | (decode_coding_object, encode_coding_object) |
| 150 | (Fdetect_coding_region, Ffind_coding_systems_region_internal) | 388 | (Fdetect_coding_region, Ffind_coding_systems_region_internal) |
| 151 | (Funencodable_char_position, Fcheck_coding_systems_region): Use | 389 | (Funencodable_char_position, Fcheck_coding_systems_region): |
| 152 | B_. | 390 | Use B_. |
| 153 | * charset.c (Ffind_charset_region): Use B_. | 391 | * charset.c (Ffind_charset_region): Use B_. |
| 154 | * window.c (window_display_table, unshow_buffer, window_loop) | 392 | * window.c (window_display_table, unshow_buffer, window_loop) |
| 155 | (window_min_size_2, set_window_buffer, Fset_window_buffer) | 393 | (window_min_size_2, set_window_buffer, Fset_window_buffer) |
| @@ -406,8 +644,8 @@ | |||
| 406 | callers changed. | 644 | callers changed. |
| 407 | * editfns.c (general_insert_function): Change signature to | 645 | * editfns.c (general_insert_function): Change signature to |
| 408 | match changes to insert functions' signatures. | 646 | match changes to insert functions' signatures. |
| 409 | * keymap.c (map_keymap_char_table_item, map_keymap_internal): Use | 647 | * keymap.c (map_keymap_char_table_item, map_keymap_internal): |
| 410 | explicit cast when converting between void * and function pointer | 648 | Use explicit cast when converting between void * and function pointer |
| 411 | types, as C89 requires this. | 649 | types, as C89 requires this. |
| 412 | 650 | ||
| 413 | 2011-02-05 Paul Eggert <eggert@cs.ucla.edu> | 651 | 2011-02-05 Paul Eggert <eggert@cs.ucla.edu> |
| @@ -527,7 +765,7 @@ | |||
| 527 | 2011-02-01 Paul Eggert <eggert@cs.ucla.edu> | 765 | 2011-02-01 Paul Eggert <eggert@cs.ucla.edu> |
| 528 | 766 | ||
| 529 | format-time-string now supports subsecond time stamp resolution | 767 | format-time-string now supports subsecond time stamp resolution |
| 530 | * editfns.c (emacs_nmemftime): Renamed from emacs_memftimeu, | 768 | * editfns.c (emacs_nmemftime): Rename from emacs_memftimeu, |
| 531 | for consistency with its new argument and with gnulib nstrftime. | 769 | for consistency with its new argument and with gnulib nstrftime. |
| 532 | All callers changed. New argument NS. | 770 | All callers changed. New argument NS. |
| 533 | (Fformat_time_string): Check that the time argument's microseconds | 771 | (Fformat_time_string): Check that the time argument's microseconds |
| @@ -857,11 +1095,11 @@ | |||
| 857 | (history_delete_duplicates, inhibit_x_resources) | 1095 | (history_delete_duplicates, inhibit_x_resources) |
| 858 | (last_nonmenu_event, load_in_progress, max_specpdl_size) | 1096 | (last_nonmenu_event, load_in_progress, max_specpdl_size) |
| 859 | (minibuffer_auto_raise, print_escape_newlines, scroll_margin) | 1097 | (minibuffer_auto_raise, print_escape_newlines, scroll_margin) |
| 860 | (use_dialog_box, use_file_dialog): Remove declaration. Include | 1098 | (use_dialog_box, use_file_dialog): Remove declaration. |
| 861 | globals.h. | 1099 | Include globals.h. |
| 862 | * keymap.h (Voverriding_local_map) | 1100 | * keymap.h (Voverriding_local_map) |
| 863 | (Voverriding_local_map_menu_flag, meta_prefix_char): Remove | 1101 | (Voverriding_local_map_menu_flag, meta_prefix_char): |
| 864 | declaration. | 1102 | Remove declaration. |
| 865 | * keyboard.h (Vdouble_click_time, Vfunction_key_map) | 1103 | * keyboard.h (Vdouble_click_time, Vfunction_key_map) |
| 866 | (Vinput_method_function, Vkey_translation_map) | 1104 | (Vinput_method_function, Vkey_translation_map) |
| 867 | (Vlucid_menu_bar_dirty_flag, Vthis_original_command) | 1105 | (Vlucid_menu_bar_dirty_flag, Vthis_original_command) |
| @@ -879,16 +1117,16 @@ | |||
| 879 | (focus_follows_mouse): Remove declaration. | 1117 | (focus_follows_mouse): Remove declaration. |
| 880 | * fontset.h (Valternate_fontname_alist, Vfontset_alias_alist) | 1118 | * fontset.h (Valternate_fontname_alist, Vfontset_alias_alist) |
| 881 | (Vignore_relative_composition, Votf_script_alist) | 1119 | (Vignore_relative_composition, Votf_script_alist) |
| 882 | (Vuse_default_ascent, Vvertical_centering_font_regexp): Remove | 1120 | (Vuse_default_ascent, Vvertical_centering_font_regexp): |
| 883 | declaration. | 1121 | Remove declaration. |
| 884 | * font.h (Vfont_log): Remove declaration. | 1122 | * font.h (Vfont_log): Remove declaration. |
| 885 | * dosfns.h (Vdos_display_scancodes, Vdos_version) | 1123 | * dosfns.h (Vdos_display_scancodes, Vdos_version) |
| 886 | (Vdos_windows_version, dos_codepage, dos_country_code) | 1124 | (Vdos_windows_version, dos_codepage, dos_country_code) |
| 887 | (dos_decimal_point, dos_hyper_key, dos_keyboard_layout) | 1125 | (dos_decimal_point, dos_hyper_key, dos_keyboard_layout) |
| 888 | (dos_keypad_mode, dos_super_key, dos_timezone_offset): Remove | 1126 | (dos_keypad_mode, dos_super_key, dos_timezone_offset): |
| 889 | declaration. | 1127 | Remove declaration. |
| 890 | * disptab.h (Vglyph_table, Vstandard_display_table): Remove | 1128 | * disptab.h (Vglyph_table, Vstandard_display_table): |
| 891 | declaration. | 1129 | Remove declaration. |
| 892 | * dispextern.h (Vface_remapping_alist, Vglyphless_char_display) | 1130 | * dispextern.h (Vface_remapping_alist, Vglyphless_char_display) |
| 893 | (Vmouse_autoselect_window, Voverflow_newline_into_fringe) | 1131 | (Vmouse_autoselect_window, Voverflow_newline_into_fringe) |
| 894 | (Vshow_trailing_whitespace, Vtool_bar_button_margin) | 1132 | (Vshow_trailing_whitespace, Vtool_bar_button_margin) |
| @@ -916,10 +1154,10 @@ | |||
| 916 | (Vselect_safe_coding_system_function) | 1154 | (Vselect_safe_coding_system_function) |
| 917 | (Vtranslation_table_for_input, coding_system_require_warning) | 1155 | (Vtranslation_table_for_input, coding_system_require_warning) |
| 918 | (eol_mnemonic_dos, eol_mnemonic_mac, eol_mnemonic_undecided) | 1156 | (eol_mnemonic_dos, eol_mnemonic_mac, eol_mnemonic_undecided) |
| 919 | (eol_mnemonic_unix, inherit_process_coding_system): Remove | 1157 | (eol_mnemonic_unix, inherit_process_coding_system): |
| 920 | declaration. | 1158 | Remove declaration. |
| 921 | * charset.h (Vcharset_list, Vcurrent_iso639_language): Remove | 1159 | * charset.h (Vcharset_list, Vcurrent_iso639_language): |
| 922 | declaration. | 1160 | Remove declaration. |
| 923 | * character.h (Vauto_fill_chars, Vchar_direction_table) | 1161 | * character.h (Vauto_fill_chars, Vchar_direction_table) |
| 924 | (Vchar_script_table, Vchar_width_table, Vprintable_chars) | 1162 | (Vchar_script_table, Vchar_width_table, Vprintable_chars) |
| 925 | (Vscript_representative_chars, Vtranslation_table_vector) | 1163 | (Vscript_representative_chars, Vtranslation_table_vector) |
| @@ -1034,8 +1272,8 @@ | |||
| 1034 | (w32_strict_fontnames, w32_strict_painting): Remove. | 1272 | (w32_strict_fontnames, w32_strict_painting): Remove. |
| 1035 | (Vhourglass_delay, Vmenu_bar_mode, Vtool_bar_mode) | 1273 | (Vhourglass_delay, Vmenu_bar_mode, Vtool_bar_mode) |
| 1036 | (Vw32_recognize_altgr, Vwindow_system_version) | 1274 | (Vw32_recognize_altgr, Vwindow_system_version) |
| 1037 | (w32_num_mouse_buttons, w32_use_visible_system_caret): Remove | 1275 | (w32_num_mouse_buttons, w32_use_visible_system_caret): |
| 1038 | declaration. | 1276 | Remove declaration. |
| 1039 | * w32console.c (syms_of_ntterm): Update. | 1277 | * w32console.c (syms_of_ntterm): Update. |
| 1040 | (w32_use_full_screen_buffer): Remove. | 1278 | (w32_use_full_screen_buffer): Remove. |
| 1041 | (Vtty_defined_color_alist): Remove declaration. | 1279 | (Vtty_defined_color_alist): Remove declaration. |
diff --git a/src/alloc.c b/src/alloc.c index 566c6fe00b9..e8b8f45e9b1 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -4842,8 +4842,6 @@ returns nil, because real GC can't be done. */) | |||
| 4842 | (void) | 4842 | (void) |
| 4843 | { | 4843 | { |
| 4844 | register struct specbinding *bind; | 4844 | register struct specbinding *bind; |
| 4845 | struct catchtag *catch; | ||
| 4846 | struct handler *handler; | ||
| 4847 | char stack_top_variable; | 4845 | char stack_top_variable; |
| 4848 | register int i; | 4846 | register int i; |
| 4849 | int message_p; | 4847 | int message_p; |
| @@ -4972,9 +4970,11 @@ returns nil, because real GC can't be done. */) | |||
| 4972 | for (i = 0; i < tail->nvars; i++) | 4970 | for (i = 0; i < tail->nvars; i++) |
| 4973 | mark_object (tail->var[i]); | 4971 | mark_object (tail->var[i]); |
| 4974 | } | 4972 | } |
| 4975 | #endif | ||
| 4976 | |||
| 4977 | mark_byte_stack (); | 4973 | mark_byte_stack (); |
| 4974 | { | ||
| 4975 | struct catchtag *catch; | ||
| 4976 | struct handler *handler; | ||
| 4977 | |||
| 4978 | for (catch = catchlist; catch; catch = catch->next) | 4978 | for (catch = catchlist; catch; catch = catch->next) |
| 4979 | { | 4979 | { |
| 4980 | mark_object (catch->tag); | 4980 | mark_object (catch->tag); |
| @@ -4985,7 +4985,9 @@ returns nil, because real GC can't be done. */) | |||
| 4985 | mark_object (handler->handler); | 4985 | mark_object (handler->handler); |
| 4986 | mark_object (handler->var); | 4986 | mark_object (handler->var); |
| 4987 | } | 4987 | } |
| 4988 | } | ||
| 4988 | mark_backtrace (); | 4989 | mark_backtrace (); |
| 4990 | #endif | ||
| 4989 | 4991 | ||
| 4990 | #ifdef HAVE_WINDOW_SYSTEM | 4992 | #ifdef HAVE_WINDOW_SYSTEM |
| 4991 | mark_fringe_data (); | 4993 | mark_fringe_data (); |
diff --git a/src/buffer.c b/src/buffer.c index 49ae4bbede2..c95fbb5f516 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, | |||
| 162 | Value is nil if OBJECT is not a buffer or if it has been killed. */) | 162 | Value is nil if OBJECT is not a buffer or if it has been killed. */) |
| 163 | (Lisp_Object object) | 163 | (Lisp_Object object) |
| 164 | { | 164 | { |
| 165 | return ((BUFFERP (object) && ! NILP (B_ (XBUFFER (object), name))) | 165 | return ((BUFFERP (object) && ! NILP (BVAR (XBUFFER (object), name))) |
| 166 | ? Qt : Qnil); | 166 | ? Qt : Qnil); |
| 167 | } | 167 | } |
| 168 | 168 | ||
| @@ -266,8 +266,8 @@ See also `find-buffer-visiting'. */) | |||
| 266 | { | 266 | { |
| 267 | buf = Fcdr (XCAR (tail)); | 267 | buf = Fcdr (XCAR (tail)); |
| 268 | if (!BUFFERP (buf)) continue; | 268 | if (!BUFFERP (buf)) continue; |
| 269 | if (!STRINGP (B_ (XBUFFER (buf), filename))) continue; | 269 | if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue; |
| 270 | tem = Fstring_equal (B_ (XBUFFER (buf), filename), filename); | 270 | tem = Fstring_equal (BVAR (XBUFFER (buf), filename), filename); |
| 271 | if (!NILP (tem)) | 271 | if (!NILP (tem)) |
| 272 | return buf; | 272 | return buf; |
| 273 | } | 273 | } |
| @@ -283,8 +283,8 @@ get_truename_buffer (register Lisp_Object filename) | |||
| 283 | { | 283 | { |
| 284 | buf = Fcdr (XCAR (tail)); | 284 | buf = Fcdr (XCAR (tail)); |
| 285 | if (!BUFFERP (buf)) continue; | 285 | if (!BUFFERP (buf)) continue; |
| 286 | if (!STRINGP (B_ (XBUFFER (buf), file_truename))) continue; | 286 | if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue; |
| 287 | tem = Fstring_equal (B_ (XBUFFER (buf), file_truename), filename); | 287 | tem = Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename); |
| 288 | if (!NILP (tem)) | 288 | if (!NILP (tem)) |
| 289 | return buf; | 289 | return buf; |
| 290 | } | 290 | } |
| @@ -353,7 +353,7 @@ even if it is dead. The return value is never nil. */) | |||
| 353 | 353 | ||
| 354 | b->newline_cache = 0; | 354 | b->newline_cache = 0; |
| 355 | b->width_run_cache = 0; | 355 | b->width_run_cache = 0; |
| 356 | B_ (b, width_table) = Qnil; | 356 | BVAR (b, width_table) = Qnil; |
| 357 | b->prevent_redisplay_optimizations_p = 1; | 357 | b->prevent_redisplay_optimizations_p = 1; |
| 358 | 358 | ||
| 359 | /* Put this on the chain of all buffers including killed ones. */ | 359 | /* 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. */) | |||
| 362 | 362 | ||
| 363 | /* An ordinary buffer normally doesn't need markers | 363 | /* An ordinary buffer normally doesn't need markers |
| 364 | to handle BEGV and ZV. */ | 364 | to handle BEGV and ZV. */ |
| 365 | B_ (b, pt_marker) = Qnil; | 365 | BVAR (b, pt_marker) = Qnil; |
| 366 | B_ (b, begv_marker) = Qnil; | 366 | BVAR (b, begv_marker) = Qnil; |
| 367 | B_ (b, zv_marker) = Qnil; | 367 | BVAR (b, zv_marker) = Qnil; |
| 368 | 368 | ||
| 369 | name = Fcopy_sequence (buffer_or_name); | 369 | name = Fcopy_sequence (buffer_or_name); |
| 370 | STRING_SET_INTERVALS (name, NULL_INTERVAL); | 370 | STRING_SET_INTERVALS (name, NULL_INTERVAL); |
| 371 | B_ (b, name) = name; | 371 | BVAR (b, name) = name; |
| 372 | 372 | ||
| 373 | B_ (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; | 373 | BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; |
| 374 | 374 | ||
| 375 | reset_buffer (b); | 375 | reset_buffer (b); |
| 376 | reset_buffer_local_variables (b, 1); | 376 | reset_buffer_local_variables (b, 1); |
| 377 | 377 | ||
| 378 | B_ (b, mark) = Fmake_marker (); | 378 | BVAR (b, mark) = Fmake_marker (); |
| 379 | BUF_MARKERS (b) = NULL; | 379 | BUF_MARKERS (b) = NULL; |
| 380 | B_ (b, name) = name; | 380 | BVAR (b, name) = name; |
| 381 | 381 | ||
| 382 | /* Put this in the alist of all live buffers. */ | 382 | /* Put this in the alist of all live buffers. */ |
| 383 | XSETBUFFER (buffer, b); | 383 | XSETBUFFER (buffer, b); |
| @@ -486,7 +486,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) | |||
| 486 | 486 | ||
| 487 | /* Get (a copy of) the alist of Lisp-level local variables of FROM | 487 | /* Get (a copy of) the alist of Lisp-level local variables of FROM |
| 488 | and install that in TO. */ | 488 | and install that in TO. */ |
| 489 | B_ (to, local_var_alist) = buffer_lisp_local_variables (from); | 489 | BVAR (to, local_var_alist) = buffer_lisp_local_variables (from); |
| 490 | } | 490 | } |
| 491 | 491 | ||
| 492 | DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, | 492 | 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. */) | |||
| 512 | base_buffer = Fget_buffer (base_buffer); | 512 | base_buffer = Fget_buffer (base_buffer); |
| 513 | if (NILP (base_buffer)) | 513 | if (NILP (base_buffer)) |
| 514 | error ("No such buffer: `%s'", SDATA (tem)); | 514 | error ("No such buffer: `%s'", SDATA (tem)); |
| 515 | if (NILP (B_ (XBUFFER (base_buffer), name))) | 515 | if (NILP (BVAR (XBUFFER (base_buffer), name))) |
| 516 | error ("Base buffer has been killed"); | 516 | error ("Base buffer has been killed"); |
| 517 | 517 | ||
| 518 | if (SCHARS (name) == 0) | 518 | if (SCHARS (name) == 0) |
| @@ -536,7 +536,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) | |||
| 536 | 536 | ||
| 537 | b->newline_cache = 0; | 537 | b->newline_cache = 0; |
| 538 | b->width_run_cache = 0; | 538 | b->width_run_cache = 0; |
| 539 | B_ (b, width_table) = Qnil; | 539 | BVAR (b, width_table) = Qnil; |
| 540 | 540 | ||
| 541 | /* Put this on the chain of all buffers including killed ones. */ | 541 | /* Put this on the chain of all buffers including killed ones. */ |
| 542 | b->next = all_buffers; | 542 | b->next = all_buffers; |
| @@ -544,7 +544,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) | |||
| 544 | 544 | ||
| 545 | name = Fcopy_sequence (name); | 545 | name = Fcopy_sequence (name); |
| 546 | STRING_SET_INTERVALS (name, NULL_INTERVAL); | 546 | STRING_SET_INTERVALS (name, NULL_INTERVAL); |
| 547 | B_ (b, name) = name; | 547 | BVAR (b, name) = name; |
| 548 | 548 | ||
| 549 | reset_buffer (b); | 549 | reset_buffer (b); |
| 550 | reset_buffer_local_variables (b, 1); | 550 | reset_buffer_local_variables (b, 1); |
| @@ -553,57 +553,57 @@ CLONE nil means the indirect buffer's state is reset to default values. */) | |||
| 553 | XSETBUFFER (buf, b); | 553 | XSETBUFFER (buf, b); |
| 554 | Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); | 554 | Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); |
| 555 | 555 | ||
| 556 | B_ (b, mark) = Fmake_marker (); | 556 | BVAR (b, mark) = Fmake_marker (); |
| 557 | B_ (b, name) = name; | 557 | BVAR (b, name) = name; |
| 558 | 558 | ||
| 559 | /* The multibyte status belongs to the base buffer. */ | 559 | /* The multibyte status belongs to the base buffer. */ |
| 560 | B_ (b, enable_multibyte_characters) = B_ (b->base_buffer, enable_multibyte_characters); | 560 | BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters); |
| 561 | 561 | ||
| 562 | /* Make sure the base buffer has markers for its narrowing. */ | 562 | /* Make sure the base buffer has markers for its narrowing. */ |
| 563 | if (NILP (B_ (b->base_buffer, pt_marker))) | 563 | if (NILP (BVAR (b->base_buffer, pt_marker))) |
| 564 | { | 564 | { |
| 565 | B_ (b->base_buffer, pt_marker) = Fmake_marker (); | 565 | BVAR (b->base_buffer, pt_marker) = Fmake_marker (); |
| 566 | set_marker_both (B_ (b->base_buffer, pt_marker), base_buffer, | 566 | set_marker_both (BVAR (b->base_buffer, pt_marker), base_buffer, |
| 567 | BUF_PT (b->base_buffer), | 567 | BUF_PT (b->base_buffer), |
| 568 | BUF_PT_BYTE (b->base_buffer)); | 568 | BUF_PT_BYTE (b->base_buffer)); |
| 569 | } | 569 | } |
| 570 | if (NILP (B_ (b->base_buffer, begv_marker))) | 570 | if (NILP (BVAR (b->base_buffer, begv_marker))) |
| 571 | { | 571 | { |
| 572 | B_ (b->base_buffer, begv_marker) = Fmake_marker (); | 572 | BVAR (b->base_buffer, begv_marker) = Fmake_marker (); |
| 573 | set_marker_both (B_ (b->base_buffer, begv_marker), base_buffer, | 573 | set_marker_both (BVAR (b->base_buffer, begv_marker), base_buffer, |
| 574 | BUF_BEGV (b->base_buffer), | 574 | BUF_BEGV (b->base_buffer), |
| 575 | BUF_BEGV_BYTE (b->base_buffer)); | 575 | BUF_BEGV_BYTE (b->base_buffer)); |
| 576 | } | 576 | } |
| 577 | if (NILP (B_ (b->base_buffer, zv_marker))) | 577 | if (NILP (BVAR (b->base_buffer, zv_marker))) |
| 578 | { | 578 | { |
| 579 | B_ (b->base_buffer, zv_marker) = Fmake_marker (); | 579 | BVAR (b->base_buffer, zv_marker) = Fmake_marker (); |
| 580 | set_marker_both (B_ (b->base_buffer, zv_marker), base_buffer, | 580 | set_marker_both (BVAR (b->base_buffer, zv_marker), base_buffer, |
| 581 | BUF_ZV (b->base_buffer), | 581 | BUF_ZV (b->base_buffer), |
| 582 | BUF_ZV_BYTE (b->base_buffer)); | 582 | BUF_ZV_BYTE (b->base_buffer)); |
| 583 | XMARKER (B_ (b->base_buffer, zv_marker))->insertion_type = 1; | 583 | XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1; |
| 584 | } | 584 | } |
| 585 | 585 | ||
| 586 | if (NILP (clone)) | 586 | if (NILP (clone)) |
| 587 | { | 587 | { |
| 588 | /* Give the indirect buffer markers for its narrowing. */ | 588 | /* Give the indirect buffer markers for its narrowing. */ |
| 589 | B_ (b, pt_marker) = Fmake_marker (); | 589 | BVAR (b, pt_marker) = Fmake_marker (); |
| 590 | set_marker_both (B_ (b, pt_marker), buf, BUF_PT (b), BUF_PT_BYTE (b)); | 590 | set_marker_both (BVAR (b, pt_marker), buf, BUF_PT (b), BUF_PT_BYTE (b)); |
| 591 | B_ (b, begv_marker) = Fmake_marker (); | 591 | BVAR (b, begv_marker) = Fmake_marker (); |
| 592 | set_marker_both (B_ (b, begv_marker), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); | 592 | set_marker_both (BVAR (b, begv_marker), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); |
| 593 | B_ (b, zv_marker) = Fmake_marker (); | 593 | BVAR (b, zv_marker) = Fmake_marker (); |
| 594 | set_marker_both (B_ (b, zv_marker), buf, BUF_ZV (b), BUF_ZV_BYTE (b)); | 594 | set_marker_both (BVAR (b, zv_marker), buf, BUF_ZV (b), BUF_ZV_BYTE (b)); |
| 595 | XMARKER (B_ (b, zv_marker))->insertion_type = 1; | 595 | XMARKER (BVAR (b, zv_marker))->insertion_type = 1; |
| 596 | } | 596 | } |
| 597 | else | 597 | else |
| 598 | { | 598 | { |
| 599 | struct buffer *old_b = current_buffer; | 599 | struct buffer *old_b = current_buffer; |
| 600 | 600 | ||
| 601 | clone_per_buffer_values (b->base_buffer, b); | 601 | clone_per_buffer_values (b->base_buffer, b); |
| 602 | B_ (b, filename) = Qnil; | 602 | BVAR (b, filename) = Qnil; |
| 603 | B_ (b, file_truename) = Qnil; | 603 | BVAR (b, file_truename) = Qnil; |
| 604 | B_ (b, display_count) = make_number (0); | 604 | BVAR (b, display_count) = make_number (0); |
| 605 | B_ (b, backed_up) = Qnil; | 605 | BVAR (b, backed_up) = Qnil; |
| 606 | B_ (b, auto_save_file_name) = Qnil; | 606 | BVAR (b, auto_save_file_name) = Qnil; |
| 607 | set_buffer_internal_1 (b); | 607 | set_buffer_internal_1 (b); |
| 608 | Fset (intern ("buffer-save-without-query"), Qnil); | 608 | Fset (intern ("buffer-save-without-query"), Qnil); |
| 609 | Fset (intern ("buffer-file-number"), Qnil); | 609 | Fset (intern ("buffer-file-number"), Qnil); |
| @@ -647,34 +647,34 @@ delete_all_overlays (struct buffer *b) | |||
| 647 | void | 647 | void |
| 648 | reset_buffer (register struct buffer *b) | 648 | reset_buffer (register struct buffer *b) |
| 649 | { | 649 | { |
| 650 | B_ (b, filename) = Qnil; | 650 | BVAR (b, filename) = Qnil; |
| 651 | B_ (b, file_truename) = Qnil; | 651 | BVAR (b, file_truename) = Qnil; |
| 652 | B_ (b, directory) = (current_buffer) ? B_ (current_buffer, directory) : Qnil; | 652 | BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil; |
| 653 | b->modtime = 0; | 653 | b->modtime = 0; |
| 654 | b->modtime_size = -1; | 654 | b->modtime_size = -1; |
| 655 | XSETFASTINT (B_ (b, save_length), 0); | 655 | XSETFASTINT (BVAR (b, save_length), 0); |
| 656 | b->last_window_start = 1; | 656 | b->last_window_start = 1; |
| 657 | /* It is more conservative to start out "changed" than "unchanged". */ | 657 | /* It is more conservative to start out "changed" than "unchanged". */ |
| 658 | b->clip_changed = 0; | 658 | b->clip_changed = 0; |
| 659 | b->prevent_redisplay_optimizations_p = 1; | 659 | b->prevent_redisplay_optimizations_p = 1; |
| 660 | B_ (b, backed_up) = Qnil; | 660 | BVAR (b, backed_up) = Qnil; |
| 661 | BUF_AUTOSAVE_MODIFF (b) = 0; | 661 | BUF_AUTOSAVE_MODIFF (b) = 0; |
| 662 | b->auto_save_failure_time = -1; | 662 | b->auto_save_failure_time = -1; |
| 663 | B_ (b, auto_save_file_name) = Qnil; | 663 | BVAR (b, auto_save_file_name) = Qnil; |
| 664 | B_ (b, read_only) = Qnil; | 664 | BVAR (b, read_only) = Qnil; |
| 665 | b->overlays_before = NULL; | 665 | b->overlays_before = NULL; |
| 666 | b->overlays_after = NULL; | 666 | b->overlays_after = NULL; |
| 667 | b->overlay_center = BEG; | 667 | b->overlay_center = BEG; |
| 668 | B_ (b, mark_active) = Qnil; | 668 | BVAR (b, mark_active) = Qnil; |
| 669 | B_ (b, point_before_scroll) = Qnil; | 669 | BVAR (b, point_before_scroll) = Qnil; |
| 670 | B_ (b, file_format) = Qnil; | 670 | BVAR (b, file_format) = Qnil; |
| 671 | B_ (b, auto_save_file_format) = Qt; | 671 | BVAR (b, auto_save_file_format) = Qt; |
| 672 | B_ (b, last_selected_window) = Qnil; | 672 | BVAR (b, last_selected_window) = Qnil; |
| 673 | XSETINT (B_ (b, display_count), 0); | 673 | XSETINT (BVAR (b, display_count), 0); |
| 674 | B_ (b, display_time) = Qnil; | 674 | BVAR (b, display_time) = Qnil; |
| 675 | B_ (b, enable_multibyte_characters) = B_ (&buffer_defaults, enable_multibyte_characters); | 675 | BVAR (b, enable_multibyte_characters) = BVAR (&buffer_defaults, enable_multibyte_characters); |
| 676 | B_ (b, cursor_type) = B_ (&buffer_defaults, cursor_type); | 676 | BVAR (b, cursor_type) = BVAR (&buffer_defaults, cursor_type); |
| 677 | B_ (b, extra_line_spacing) = B_ (&buffer_defaults, extra_line_spacing); | 677 | BVAR (b, extra_line_spacing) = BVAR (&buffer_defaults, extra_line_spacing); |
| 678 | 678 | ||
| 679 | b->display_error_modiff = 0; | 679 | b->display_error_modiff = 0; |
| 680 | } | 680 | } |
| @@ -698,10 +698,10 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) | |||
| 698 | things that depend on the major mode. | 698 | things that depend on the major mode. |
| 699 | default-major-mode is handled at a higher level. | 699 | default-major-mode is handled at a higher level. |
| 700 | We ignore it here. */ | 700 | We ignore it here. */ |
| 701 | B_ (b, major_mode) = Qfundamental_mode; | 701 | BVAR (b, major_mode) = Qfundamental_mode; |
| 702 | B_ (b, keymap) = Qnil; | 702 | BVAR (b, keymap) = Qnil; |
| 703 | B_ (b, mode_name) = QSFundamental; | 703 | BVAR (b, mode_name) = QSFundamental; |
| 704 | B_ (b, minor_modes) = Qnil; | 704 | BVAR (b, minor_modes) = Qnil; |
| 705 | 705 | ||
| 706 | /* If the standard case table has been altered and invalidated, | 706 | /* If the standard case table has been altered and invalidated, |
| 707 | fix up its insides first. */ | 707 | fix up its insides first. */ |
| @@ -710,22 +710,19 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) | |||
| 710 | && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) | 710 | && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) |
| 711 | Fset_standard_case_table (Vascii_downcase_table); | 711 | Fset_standard_case_table (Vascii_downcase_table); |
| 712 | 712 | ||
| 713 | B_ (b, downcase_table) = Vascii_downcase_table; | 713 | BVAR (b, downcase_table) = Vascii_downcase_table; |
| 714 | B_ (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; | 714 | BVAR (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; |
| 715 | B_ (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; | 715 | BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; |
| 716 | B_ (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; | 716 | BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; |
| 717 | B_ (b, invisibility_spec) = Qt; | 717 | BVAR (b, invisibility_spec) = Qt; |
| 718 | #ifndef DOS_NT | ||
| 719 | B_ (b, buffer_file_type) = Qnil; | ||
| 720 | #endif | ||
| 721 | 718 | ||
| 722 | /* Reset all (or most) per-buffer variables to their defaults. */ | 719 | /* Reset all (or most) per-buffer variables to their defaults. */ |
| 723 | if (permanent_too) | 720 | if (permanent_too) |
| 724 | B_ (b, local_var_alist) = Qnil; | 721 | BVAR (b, local_var_alist) = Qnil; |
| 725 | else | 722 | else |
| 726 | { | 723 | { |
| 727 | Lisp_Object tmp, prop, last = Qnil; | 724 | Lisp_Object tmp, prop, last = Qnil; |
| 728 | for (tmp = B_ (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) | 725 | for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) |
| 729 | if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) | 726 | if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) |
| 730 | { | 727 | { |
| 731 | /* If permanent-local, keep it. */ | 728 | /* If permanent-local, keep it. */ |
| @@ -755,7 +752,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) | |||
| 755 | } | 752 | } |
| 756 | /* Delete this local variable. */ | 753 | /* Delete this local variable. */ |
| 757 | else if (NILP (last)) | 754 | else if (NILP (last)) |
| 758 | B_ (b, local_var_alist) = XCDR (tmp); | 755 | BVAR (b, local_var_alist) = XCDR (tmp); |
| 759 | else | 756 | else |
| 760 | XSETCDR (last, XCDR (tmp)); | 757 | XSETCDR (last, XCDR (tmp)); |
| 761 | } | 758 | } |
| @@ -830,9 +827,9 @@ Return nil if BUFFER has been killed. */) | |||
| 830 | (register Lisp_Object buffer) | 827 | (register Lisp_Object buffer) |
| 831 | { | 828 | { |
| 832 | if (NILP (buffer)) | 829 | if (NILP (buffer)) |
| 833 | return B_ (current_buffer, name); | 830 | return BVAR (current_buffer, name); |
| 834 | CHECK_BUFFER (buffer); | 831 | CHECK_BUFFER (buffer); |
| 835 | return B_ (XBUFFER (buffer), name); | 832 | return BVAR (XBUFFER (buffer), name); |
| 836 | } | 833 | } |
| 837 | 834 | ||
| 838 | DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, | 835 | DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, |
| @@ -841,9 +838,9 @@ No argument or nil as argument means use the current buffer. */) | |||
| 841 | (register Lisp_Object buffer) | 838 | (register Lisp_Object buffer) |
| 842 | { | 839 | { |
| 843 | if (NILP (buffer)) | 840 | if (NILP (buffer)) |
| 844 | return B_ (current_buffer, filename); | 841 | return BVAR (current_buffer, filename); |
| 845 | CHECK_BUFFER (buffer); | 842 | CHECK_BUFFER (buffer); |
| 846 | return B_ (XBUFFER (buffer), filename); | 843 | return BVAR (XBUFFER (buffer), filename); |
| 847 | } | 844 | } |
| 848 | 845 | ||
| 849 | DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, | 846 | DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, |
| @@ -895,7 +892,7 @@ is the default binding of the variable. */) | |||
| 895 | { /* Look in local_var_alist. */ | 892 | { /* Look in local_var_alist. */ |
| 896 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); | 893 | struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); |
| 897 | XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ | 894 | XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ |
| 898 | result = Fassoc (variable, B_ (buf, local_var_alist)); | 895 | result = Fassoc (variable, BVAR (buf, local_var_alist)); |
| 899 | if (!NILP (result)) | 896 | if (!NILP (result)) |
| 900 | { | 897 | { |
| 901 | if (blv->fwd) | 898 | if (blv->fwd) |
| @@ -944,7 +941,7 @@ buffer_lisp_local_variables (struct buffer *buf) | |||
| 944 | { | 941 | { |
| 945 | Lisp_Object result = Qnil; | 942 | Lisp_Object result = Qnil; |
| 946 | register Lisp_Object tail; | 943 | register Lisp_Object tail; |
| 947 | for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) | 944 | for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) |
| 948 | { | 945 | { |
| 949 | Lisp_Object val, elt; | 946 | Lisp_Object val, elt; |
| 950 | 947 | ||
| @@ -1043,9 +1040,9 @@ A non-nil FLAG means mark the buffer modified. */) | |||
| 1043 | /* If buffer becoming modified, lock the file. | 1040 | /* If buffer becoming modified, lock the file. |
| 1044 | If buffer becoming unmodified, unlock the file. */ | 1041 | If buffer becoming unmodified, unlock the file. */ |
| 1045 | 1042 | ||
| 1046 | fn = B_ (current_buffer, file_truename); | 1043 | fn = BVAR (current_buffer, file_truename); |
| 1047 | /* Test buffer-file-name so that binding it to nil is effective. */ | 1044 | /* Test buffer-file-name so that binding it to nil is effective. */ |
| 1048 | if (!NILP (fn) && ! NILP (B_ (current_buffer, filename))) | 1045 | if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename))) |
| 1049 | { | 1046 | { |
| 1050 | already = SAVE_MODIFF < MODIFF; | 1047 | already = SAVE_MODIFF < MODIFF; |
| 1051 | if (!already && !NILP (flag)) | 1048 | if (!already && !NILP (flag)) |
| @@ -1110,9 +1107,9 @@ state of the current buffer. Use with care. */) | |||
| 1110 | /* If buffer becoming modified, lock the file. | 1107 | /* If buffer becoming modified, lock the file. |
| 1111 | If buffer becoming unmodified, unlock the file. */ | 1108 | If buffer becoming unmodified, unlock the file. */ |
| 1112 | 1109 | ||
| 1113 | fn = B_ (current_buffer, file_truename); | 1110 | fn = BVAR (current_buffer, file_truename); |
| 1114 | /* Test buffer-file-name so that binding it to nil is effective. */ | 1111 | /* Test buffer-file-name so that binding it to nil is effective. */ |
| 1115 | if (!NILP (fn) && ! NILP (B_ (current_buffer, filename))) | 1112 | if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename))) |
| 1116 | { | 1113 | { |
| 1117 | int already = SAVE_MODIFF < MODIFF; | 1114 | int already = SAVE_MODIFF < MODIFF; |
| 1118 | if (!already && !NILP (flag)) | 1115 | if (!already && !NILP (flag)) |
| @@ -1199,14 +1196,14 @@ This does not change the name of the visited file (if any). */) | |||
| 1199 | with the original name. It makes UNIQUE equivalent to | 1196 | with the original name. It makes UNIQUE equivalent to |
| 1200 | (rename-buffer (generate-new-buffer-name NEWNAME)). */ | 1197 | (rename-buffer (generate-new-buffer-name NEWNAME)). */ |
| 1201 | if (NILP (unique) && XBUFFER (tem) == current_buffer) | 1198 | if (NILP (unique) && XBUFFER (tem) == current_buffer) |
| 1202 | return B_ (current_buffer, name); | 1199 | return BVAR (current_buffer, name); |
| 1203 | if (!NILP (unique)) | 1200 | if (!NILP (unique)) |
| 1204 | newname = Fgenerate_new_buffer_name (newname, B_ (current_buffer, name)); | 1201 | newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name)); |
| 1205 | else | 1202 | else |
| 1206 | error ("Buffer name `%s' is in use", SDATA (newname)); | 1203 | error ("Buffer name `%s' is in use", SDATA (newname)); |
| 1207 | } | 1204 | } |
| 1208 | 1205 | ||
| 1209 | B_ (current_buffer, name) = newname; | 1206 | BVAR (current_buffer, name) = newname; |
| 1210 | 1207 | ||
| 1211 | /* Catch redisplay's attention. Unless we do this, the mode lines for | 1208 | /* Catch redisplay's attention. Unless we do this, the mode lines for |
| 1212 | any windows displaying current_buffer will stay unchanged. */ | 1209 | any windows displaying current_buffer will stay unchanged. */ |
| @@ -1214,11 +1211,11 @@ This does not change the name of the visited file (if any). */) | |||
| 1214 | 1211 | ||
| 1215 | XSETBUFFER (buf, current_buffer); | 1212 | XSETBUFFER (buf, current_buffer); |
| 1216 | Fsetcar (Frassq (buf, Vbuffer_alist), newname); | 1213 | Fsetcar (Frassq (buf, Vbuffer_alist), newname); |
| 1217 | if (NILP (B_ (current_buffer, filename)) | 1214 | if (NILP (BVAR (current_buffer, filename)) |
| 1218 | && !NILP (B_ (current_buffer, auto_save_file_name))) | 1215 | && !NILP (BVAR (current_buffer, auto_save_file_name))) |
| 1219 | call0 (intern ("rename-auto-save-file")); | 1216 | call0 (intern ("rename-auto-save-file")); |
| 1220 | /* Refetch since that last call may have done GC. */ | 1217 | /* Refetch since that last call may have done GC. */ |
| 1221 | return B_ (current_buffer, name); | 1218 | return BVAR (current_buffer, name); |
| 1222 | } | 1219 | } |
| 1223 | 1220 | ||
| 1224 | DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, | 1221 | DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, |
| @@ -1263,9 +1260,9 @@ If BUFFER is omitted or nil, some interesting buffer is returned. */) | |||
| 1263 | continue; | 1260 | continue; |
| 1264 | if (NILP (buf)) | 1261 | if (NILP (buf)) |
| 1265 | continue; | 1262 | continue; |
| 1266 | if (NILP (B_ (XBUFFER (buf), name))) | 1263 | if (NILP (BVAR (XBUFFER (buf), name))) |
| 1267 | continue; | 1264 | continue; |
| 1268 | if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') | 1265 | if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') |
| 1269 | continue; | 1266 | continue; |
| 1270 | /* If the selected frame has a buffer_predicate, | 1267 | /* If the selected frame has a buffer_predicate, |
| 1271 | disregard buffers that don't fit the predicate. */ | 1268 | disregard buffers that don't fit the predicate. */ |
| @@ -1313,8 +1310,8 @@ No argument or nil as argument means do this for the current buffer. */) | |||
| 1313 | nsberror (buffer); | 1310 | nsberror (buffer); |
| 1314 | } | 1311 | } |
| 1315 | 1312 | ||
| 1316 | if (EQ (B_ (XBUFFER (real_buffer), undo_list), Qt)) | 1313 | if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt)) |
| 1317 | B_ (XBUFFER (real_buffer), undo_list) = Qnil; | 1314 | BVAR (XBUFFER (real_buffer), undo_list) = Qnil; |
| 1318 | 1315 | ||
| 1319 | return Qnil; | 1316 | return Qnil; |
| 1320 | } | 1317 | } |
| @@ -1359,16 +1356,16 @@ with SIGHUP. */) | |||
| 1359 | b = XBUFFER (buffer); | 1356 | b = XBUFFER (buffer); |
| 1360 | 1357 | ||
| 1361 | /* Avoid trouble for buffer already dead. */ | 1358 | /* Avoid trouble for buffer already dead. */ |
| 1362 | if (NILP (B_ (b, name))) | 1359 | if (NILP (BVAR (b, name))) |
| 1363 | return Qnil; | 1360 | return Qnil; |
| 1364 | 1361 | ||
| 1365 | /* Query if the buffer is still modified. */ | 1362 | /* Query if the buffer is still modified. */ |
| 1366 | if (INTERACTIVE && !NILP (B_ (b, filename)) | 1363 | if (INTERACTIVE && !NILP (BVAR (b, filename)) |
| 1367 | && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) | 1364 | && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) |
| 1368 | { | 1365 | { |
| 1369 | GCPRO1 (buffer); | 1366 | GCPRO1 (buffer); |
| 1370 | tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ", | 1367 | tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ", |
| 1371 | B_ (b, name), make_number (0))); | 1368 | BVAR (b, name), make_number (0))); |
| 1372 | UNGCPRO; | 1369 | UNGCPRO; |
| 1373 | if (NILP (tem)) | 1370 | if (NILP (tem)) |
| 1374 | return Qnil; | 1371 | return Qnil; |
| @@ -1402,7 +1399,7 @@ with SIGHUP. */) | |||
| 1402 | if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) | 1399 | if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) |
| 1403 | return Qnil; | 1400 | return Qnil; |
| 1404 | 1401 | ||
| 1405 | if (NILP (B_ (b, name))) | 1402 | if (NILP (BVAR (b, name))) |
| 1406 | return Qnil; | 1403 | return Qnil; |
| 1407 | 1404 | ||
| 1408 | /* When we kill a base buffer, kill all its indirect buffers. | 1405 | /* When we kill a base buffer, kill all its indirect buffers. |
| @@ -1417,7 +1414,7 @@ with SIGHUP. */) | |||
| 1417 | for (other = all_buffers; other; other = other->next) | 1414 | for (other = all_buffers; other; other = other->next) |
| 1418 | /* all_buffers contains dead buffers too; | 1415 | /* all_buffers contains dead buffers too; |
| 1419 | don't re-kill them. */ | 1416 | don't re-kill them. */ |
| 1420 | if (other->base_buffer == b && !NILP (B_ (other, name))) | 1417 | if (other->base_buffer == b && !NILP (BVAR (other, name))) |
| 1421 | { | 1418 | { |
| 1422 | Lisp_Object buffer; | 1419 | Lisp_Object buffer; |
| 1423 | XSETBUFFER (buffer, other); | 1420 | XSETBUFFER (buffer, other); |
| @@ -1462,7 +1459,7 @@ with SIGHUP. */) | |||
| 1462 | /* Killing buffer processes may run sentinels which may | 1459 | /* Killing buffer processes may run sentinels which may |
| 1463 | have called kill-buffer. */ | 1460 | have called kill-buffer. */ |
| 1464 | 1461 | ||
| 1465 | if (NILP (B_ (b, name))) | 1462 | if (NILP (BVAR (b, name))) |
| 1466 | return Qnil; | 1463 | return Qnil; |
| 1467 | 1464 | ||
| 1468 | clear_charpos_cache (b); | 1465 | clear_charpos_cache (b); |
| @@ -1476,7 +1473,7 @@ with SIGHUP. */) | |||
| 1476 | 1473 | ||
| 1477 | /* Delete any auto-save file, if we saved it in this session. | 1474 | /* Delete any auto-save file, if we saved it in this session. |
| 1478 | But not if the buffer is modified. */ | 1475 | But not if the buffer is modified. */ |
| 1479 | if (STRINGP (B_ (b, auto_save_file_name)) | 1476 | if (STRINGP (BVAR (b, auto_save_file_name)) |
| 1480 | && BUF_AUTOSAVE_MODIFF (b) != 0 | 1477 | && BUF_AUTOSAVE_MODIFF (b) != 0 |
| 1481 | && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) | 1478 | && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) |
| 1482 | && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) | 1479 | && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) |
| @@ -1485,7 +1482,7 @@ with SIGHUP. */) | |||
| 1485 | Lisp_Object tem; | 1482 | Lisp_Object tem; |
| 1486 | tem = Fsymbol_value (intern ("delete-auto-save-files")); | 1483 | tem = Fsymbol_value (intern ("delete-auto-save-files")); |
| 1487 | if (! NILP (tem)) | 1484 | if (! NILP (tem)) |
| 1488 | internal_delete_file (B_ (b, auto_save_file_name)); | 1485 | internal_delete_file (BVAR (b, auto_save_file_name)); |
| 1489 | } | 1486 | } |
| 1490 | 1487 | ||
| 1491 | if (b->base_buffer) | 1488 | if (b->base_buffer) |
| @@ -1525,7 +1522,7 @@ with SIGHUP. */) | |||
| 1525 | swap_out_buffer_local_variables (b); | 1522 | swap_out_buffer_local_variables (b); |
| 1526 | reset_buffer_local_variables (b, 1); | 1523 | reset_buffer_local_variables (b, 1); |
| 1527 | 1524 | ||
| 1528 | B_ (b, name) = Qnil; | 1525 | BVAR (b, name) = Qnil; |
| 1529 | 1526 | ||
| 1530 | BLOCK_INPUT; | 1527 | BLOCK_INPUT; |
| 1531 | if (! b->base_buffer) | 1528 | if (! b->base_buffer) |
| @@ -1541,9 +1538,9 @@ with SIGHUP. */) | |||
| 1541 | free_region_cache (b->width_run_cache); | 1538 | free_region_cache (b->width_run_cache); |
| 1542 | b->width_run_cache = 0; | 1539 | b->width_run_cache = 0; |
| 1543 | } | 1540 | } |
| 1544 | B_ (b, width_table) = Qnil; | 1541 | BVAR (b, width_table) = Qnil; |
| 1545 | UNBLOCK_INPUT; | 1542 | UNBLOCK_INPUT; |
| 1546 | B_ (b, undo_list) = Qnil; | 1543 | BVAR (b, undo_list) = Qnil; |
| 1547 | 1544 | ||
| 1548 | return Qt; | 1545 | return Qt; |
| 1549 | } | 1546 | } |
| @@ -1637,15 +1634,15 @@ the current buffer's major mode. */) | |||
| 1637 | 1634 | ||
| 1638 | CHECK_BUFFER (buffer); | 1635 | CHECK_BUFFER (buffer); |
| 1639 | 1636 | ||
| 1640 | if (STRINGP (B_ (XBUFFER (buffer), name)) | 1637 | if (STRINGP (BVAR (XBUFFER (buffer), name)) |
| 1641 | && strcmp (SSDATA (B_ (XBUFFER (buffer), name)), "*scratch*") == 0) | 1638 | && strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0) |
| 1642 | function = find_symbol_value (intern ("initial-major-mode")); | 1639 | function = find_symbol_value (intern ("initial-major-mode")); |
| 1643 | else | 1640 | else |
| 1644 | { | 1641 | { |
| 1645 | function = B_ (&buffer_defaults, major_mode); | 1642 | function = BVAR (&buffer_defaults, major_mode); |
| 1646 | if (NILP (function) | 1643 | if (NILP (function) |
| 1647 | && NILP (Fget (B_ (current_buffer, major_mode), Qmode_class))) | 1644 | && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class))) |
| 1648 | function = B_ (current_buffer, major_mode); | 1645 | function = BVAR (current_buffer, major_mode); |
| 1649 | } | 1646 | } |
| 1650 | 1647 | ||
| 1651 | if (NILP (function) || EQ (function, Qfundamental_mode)) | 1648 | if (NILP (function) || EQ (function, Qfundamental_mode)) |
| @@ -1795,29 +1792,29 @@ set_buffer_internal_1 (register struct buffer *b) | |||
| 1795 | /* Put the undo list back in the base buffer, so that it appears | 1792 | /* Put the undo list back in the base buffer, so that it appears |
| 1796 | that an indirect buffer shares the undo list of its base. */ | 1793 | that an indirect buffer shares the undo list of its base. */ |
| 1797 | if (old_buf->base_buffer) | 1794 | if (old_buf->base_buffer) |
| 1798 | B_ (old_buf->base_buffer, undo_list) = B_ (old_buf, undo_list); | 1795 | BVAR (old_buf->base_buffer, undo_list) = BVAR (old_buf, undo_list); |
| 1799 | 1796 | ||
| 1800 | /* If the old current buffer has markers to record PT, BEGV and ZV | 1797 | /* If the old current buffer has markers to record PT, BEGV and ZV |
| 1801 | when it is not current, update them now. */ | 1798 | when it is not current, update them now. */ |
| 1802 | if (! NILP (B_ (old_buf, pt_marker))) | 1799 | if (! NILP (BVAR (old_buf, pt_marker))) |
| 1803 | { | 1800 | { |
| 1804 | Lisp_Object obuf; | 1801 | Lisp_Object obuf; |
| 1805 | XSETBUFFER (obuf, old_buf); | 1802 | XSETBUFFER (obuf, old_buf); |
| 1806 | set_marker_both (B_ (old_buf, pt_marker), obuf, | 1803 | set_marker_both (BVAR (old_buf, pt_marker), obuf, |
| 1807 | BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); | 1804 | BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); |
| 1808 | } | 1805 | } |
| 1809 | if (! NILP (B_ (old_buf, begv_marker))) | 1806 | if (! NILP (BVAR (old_buf, begv_marker))) |
| 1810 | { | 1807 | { |
| 1811 | Lisp_Object obuf; | 1808 | Lisp_Object obuf; |
| 1812 | XSETBUFFER (obuf, old_buf); | 1809 | XSETBUFFER (obuf, old_buf); |
| 1813 | set_marker_both (B_ (old_buf, begv_marker), obuf, | 1810 | set_marker_both (BVAR (old_buf, begv_marker), obuf, |
| 1814 | BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); | 1811 | BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); |
| 1815 | } | 1812 | } |
| 1816 | if (! NILP (B_ (old_buf, zv_marker))) | 1813 | if (! NILP (BVAR (old_buf, zv_marker))) |
| 1817 | { | 1814 | { |
| 1818 | Lisp_Object obuf; | 1815 | Lisp_Object obuf; |
| 1819 | XSETBUFFER (obuf, old_buf); | 1816 | XSETBUFFER (obuf, old_buf); |
| 1820 | set_marker_both (B_ (old_buf, zv_marker), obuf, | 1817 | set_marker_both (BVAR (old_buf, zv_marker), obuf, |
| 1821 | BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); | 1818 | BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); |
| 1822 | } | 1819 | } |
| 1823 | } | 1820 | } |
| @@ -1825,24 +1822,24 @@ set_buffer_internal_1 (register struct buffer *b) | |||
| 1825 | /* Get the undo list from the base buffer, so that it appears | 1822 | /* Get the undo list from the base buffer, so that it appears |
| 1826 | that an indirect buffer shares the undo list of its base. */ | 1823 | that an indirect buffer shares the undo list of its base. */ |
| 1827 | if (b->base_buffer) | 1824 | if (b->base_buffer) |
| 1828 | B_ (b, undo_list) = B_ (b->base_buffer, undo_list); | 1825 | BVAR (b, undo_list) = BVAR (b->base_buffer, undo_list); |
| 1829 | 1826 | ||
| 1830 | /* If the new current buffer has markers to record PT, BEGV and ZV | 1827 | /* If the new current buffer has markers to record PT, BEGV and ZV |
| 1831 | when it is not current, fetch them now. */ | 1828 | when it is not current, fetch them now. */ |
| 1832 | if (! NILP (B_ (b, pt_marker))) | 1829 | if (! NILP (BVAR (b, pt_marker))) |
| 1833 | { | 1830 | { |
| 1834 | BUF_PT (b) = marker_position (B_ (b, pt_marker)); | 1831 | BUF_PT (b) = marker_position (BVAR (b, pt_marker)); |
| 1835 | BUF_PT_BYTE (b) = marker_byte_position (B_ (b, pt_marker)); | 1832 | BUF_PT_BYTE (b) = marker_byte_position (BVAR (b, pt_marker)); |
| 1836 | } | 1833 | } |
| 1837 | if (! NILP (B_ (b, begv_marker))) | 1834 | if (! NILP (BVAR (b, begv_marker))) |
| 1838 | { | 1835 | { |
| 1839 | BUF_BEGV (b) = marker_position (B_ (b, begv_marker)); | 1836 | BUF_BEGV (b) = marker_position (BVAR (b, begv_marker)); |
| 1840 | BUF_BEGV_BYTE (b) = marker_byte_position (B_ (b, begv_marker)); | 1837 | BUF_BEGV_BYTE (b) = marker_byte_position (BVAR (b, begv_marker)); |
| 1841 | } | 1838 | } |
| 1842 | if (! NILP (B_ (b, zv_marker))) | 1839 | if (! NILP (BVAR (b, zv_marker))) |
| 1843 | { | 1840 | { |
| 1844 | BUF_ZV (b) = marker_position (B_ (b, zv_marker)); | 1841 | BUF_ZV (b) = marker_position (BVAR (b, zv_marker)); |
| 1845 | BUF_ZV_BYTE (b) = marker_byte_position (B_ (b, zv_marker)); | 1842 | BUF_ZV_BYTE (b) = marker_byte_position (BVAR (b, zv_marker)); |
| 1846 | } | 1843 | } |
| 1847 | 1844 | ||
| 1848 | /* Look down buffer's list of local Lisp variables | 1845 | /* Look down buffer's list of local Lisp variables |
| @@ -1850,7 +1847,7 @@ set_buffer_internal_1 (register struct buffer *b) | |||
| 1850 | 1847 | ||
| 1851 | do | 1848 | do |
| 1852 | { | 1849 | { |
| 1853 | for (tail = B_ (b, local_var_alist); CONSP (tail); tail = XCDR (tail)) | 1850 | for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail)) |
| 1854 | { | 1851 | { |
| 1855 | Lisp_Object var = XCAR (XCAR (tail)); | 1852 | Lisp_Object var = XCAR (XCAR (tail)); |
| 1856 | struct Lisp_Symbol *sym = XSYMBOL (var); | 1853 | struct Lisp_Symbol *sym = XSYMBOL (var); |
| @@ -1883,45 +1880,45 @@ set_buffer_temp (struct buffer *b) | |||
| 1883 | { | 1880 | { |
| 1884 | /* If the old current buffer has markers to record PT, BEGV and ZV | 1881 | /* If the old current buffer has markers to record PT, BEGV and ZV |
| 1885 | when it is not current, update them now. */ | 1882 | when it is not current, update them now. */ |
| 1886 | if (! NILP (B_ (old_buf, pt_marker))) | 1883 | if (! NILP (BVAR (old_buf, pt_marker))) |
| 1887 | { | 1884 | { |
| 1888 | Lisp_Object obuf; | 1885 | Lisp_Object obuf; |
| 1889 | XSETBUFFER (obuf, old_buf); | 1886 | XSETBUFFER (obuf, old_buf); |
| 1890 | set_marker_both (B_ (old_buf, pt_marker), obuf, | 1887 | set_marker_both (BVAR (old_buf, pt_marker), obuf, |
| 1891 | BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); | 1888 | BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); |
| 1892 | } | 1889 | } |
| 1893 | if (! NILP (B_ (old_buf, begv_marker))) | 1890 | if (! NILP (BVAR (old_buf, begv_marker))) |
| 1894 | { | 1891 | { |
| 1895 | Lisp_Object obuf; | 1892 | Lisp_Object obuf; |
| 1896 | XSETBUFFER (obuf, old_buf); | 1893 | XSETBUFFER (obuf, old_buf); |
| 1897 | set_marker_both (B_ (old_buf, begv_marker), obuf, | 1894 | set_marker_both (BVAR (old_buf, begv_marker), obuf, |
| 1898 | BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); | 1895 | BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); |
| 1899 | } | 1896 | } |
| 1900 | if (! NILP (B_ (old_buf, zv_marker))) | 1897 | if (! NILP (BVAR (old_buf, zv_marker))) |
| 1901 | { | 1898 | { |
| 1902 | Lisp_Object obuf; | 1899 | Lisp_Object obuf; |
| 1903 | XSETBUFFER (obuf, old_buf); | 1900 | XSETBUFFER (obuf, old_buf); |
| 1904 | set_marker_both (B_ (old_buf, zv_marker), obuf, | 1901 | set_marker_both (BVAR (old_buf, zv_marker), obuf, |
| 1905 | BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); | 1902 | BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); |
| 1906 | } | 1903 | } |
| 1907 | } | 1904 | } |
| 1908 | 1905 | ||
| 1909 | /* If the new current buffer has markers to record PT, BEGV and ZV | 1906 | /* If the new current buffer has markers to record PT, BEGV and ZV |
| 1910 | when it is not current, fetch them now. */ | 1907 | when it is not current, fetch them now. */ |
| 1911 | if (! NILP (B_ (b, pt_marker))) | 1908 | if (! NILP (BVAR (b, pt_marker))) |
| 1912 | { | 1909 | { |
| 1913 | BUF_PT (b) = marker_position (B_ (b, pt_marker)); | 1910 | BUF_PT (b) = marker_position (BVAR (b, pt_marker)); |
| 1914 | BUF_PT_BYTE (b) = marker_byte_position (B_ (b, pt_marker)); | 1911 | BUF_PT_BYTE (b) = marker_byte_position (BVAR (b, pt_marker)); |
| 1915 | } | 1912 | } |
| 1916 | if (! NILP (B_ (b, begv_marker))) | 1913 | if (! NILP (BVAR (b, begv_marker))) |
| 1917 | { | 1914 | { |
| 1918 | BUF_BEGV (b) = marker_position (B_ (b, begv_marker)); | 1915 | BUF_BEGV (b) = marker_position (BVAR (b, begv_marker)); |
| 1919 | BUF_BEGV_BYTE (b) = marker_byte_position (B_ (b, begv_marker)); | 1916 | BUF_BEGV_BYTE (b) = marker_byte_position (BVAR (b, begv_marker)); |
| 1920 | } | 1917 | } |
| 1921 | if (! NILP (B_ (b, zv_marker))) | 1918 | if (! NILP (BVAR (b, zv_marker))) |
| 1922 | { | 1919 | { |
| 1923 | BUF_ZV (b) = marker_position (B_ (b, zv_marker)); | 1920 | BUF_ZV (b) = marker_position (BVAR (b, zv_marker)); |
| 1924 | BUF_ZV_BYTE (b) = marker_byte_position (B_ (b, zv_marker)); | 1921 | BUF_ZV_BYTE (b) = marker_byte_position (BVAR (b, zv_marker)); |
| 1925 | } | 1922 | } |
| 1926 | } | 1923 | } |
| 1927 | 1924 | ||
| @@ -1938,7 +1935,7 @@ ends when the current command terminates. Use `switch-to-buffer' or | |||
| 1938 | buffer = Fget_buffer (buffer_or_name); | 1935 | buffer = Fget_buffer (buffer_or_name); |
| 1939 | if (NILP (buffer)) | 1936 | if (NILP (buffer)) |
| 1940 | nsberror (buffer_or_name); | 1937 | nsberror (buffer_or_name); |
| 1941 | if (NILP (B_ (XBUFFER (buffer), name))) | 1938 | if (NILP (BVAR (XBUFFER (buffer), name))) |
| 1942 | error ("Selecting deleted buffer"); | 1939 | error ("Selecting deleted buffer"); |
| 1943 | set_buffer_internal (XBUFFER (buffer)); | 1940 | set_buffer_internal (XBUFFER (buffer)); |
| 1944 | return buffer; | 1941 | return buffer; |
| @@ -1949,7 +1946,7 @@ ends when the current command terminates. Use `switch-to-buffer' or | |||
| 1949 | Lisp_Object | 1946 | Lisp_Object |
| 1950 | set_buffer_if_live (Lisp_Object buffer) | 1947 | set_buffer_if_live (Lisp_Object buffer) |
| 1951 | { | 1948 | { |
| 1952 | if (! NILP (B_ (XBUFFER (buffer), name))) | 1949 | if (! NILP (BVAR (XBUFFER (buffer), name))) |
| 1953 | Fset_buffer (buffer); | 1950 | Fset_buffer (buffer); |
| 1954 | return Qnil; | 1951 | return Qnil; |
| 1955 | } | 1952 | } |
| @@ -1959,7 +1956,7 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, | |||
| 1959 | doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */) | 1956 | doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */) |
| 1960 | (void) | 1957 | (void) |
| 1961 | { | 1958 | { |
| 1962 | if (!NILP (B_ (current_buffer, read_only)) | 1959 | if (!NILP (BVAR (current_buffer, read_only)) |
| 1963 | && NILP (Vinhibit_read_only)) | 1960 | && NILP (Vinhibit_read_only)) |
| 1964 | xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); | 1961 | xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); |
| 1965 | return Qnil; | 1962 | return Qnil; |
| @@ -2008,7 +2005,7 @@ its frame, iconify that frame. */) | |||
| 2008 | 2005 | ||
| 2009 | /* Move buffer to the end of the buffer list. Do nothing if the | 2006 | /* Move buffer to the end of the buffer list. Do nothing if the |
| 2010 | buffer is killed. */ | 2007 | buffer is killed. */ |
| 2011 | if (!NILP (B_ (XBUFFER (buffer), name))) | 2008 | if (!NILP (BVAR (XBUFFER (buffer), name))) |
| 2012 | { | 2009 | { |
| 2013 | Lisp_Object aelt, link; | 2010 | Lisp_Object aelt, link; |
| 2014 | 2011 | ||
| @@ -2041,7 +2038,7 @@ so the buffer is truly empty after this. */) | |||
| 2041 | /* Prevent warnings, or suspension of auto saving, that would happen | 2038 | /* Prevent warnings, or suspension of auto saving, that would happen |
| 2042 | if future size is less than past size. Use of erase-buffer | 2039 | if future size is less than past size. Use of erase-buffer |
| 2043 | implies that the future text is not really related to the past text. */ | 2040 | implies that the future text is not really related to the past text. */ |
| 2044 | XSETFASTINT (B_ (current_buffer, save_length), 0); | 2041 | XSETFASTINT (BVAR (current_buffer, save_length), 0); |
| 2045 | return Qnil; | 2042 | return Qnil; |
| 2046 | } | 2043 | } |
| 2047 | 2044 | ||
| @@ -2111,7 +2108,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, | |||
| 2111 | CHECK_BUFFER (buffer); | 2108 | CHECK_BUFFER (buffer); |
| 2112 | other_buffer = XBUFFER (buffer); | 2109 | other_buffer = XBUFFER (buffer); |
| 2113 | 2110 | ||
| 2114 | if (NILP (B_ (other_buffer, name))) | 2111 | if (NILP (BVAR (other_buffer, name))) |
| 2115 | error ("Cannot swap a dead buffer's text"); | 2112 | error ("Cannot swap a dead buffer's text"); |
| 2116 | 2113 | ||
| 2117 | /* Actually, it probably works just fine. | 2114 | /* Actually, it probably works just fine. |
| @@ -2140,9 +2137,9 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, | |||
| 2140 | } while (0) | 2137 | } while (0) |
| 2141 | #define swapfield_(field, type) \ | 2138 | #define swapfield_(field, type) \ |
| 2142 | do { \ | 2139 | do { \ |
| 2143 | type tmp##field = B_ (other_buffer, field); \ | 2140 | type tmp##field = BVAR (other_buffer, field); \ |
| 2144 | B_ (other_buffer, field) = B_ (current_buffer, field); \ | 2141 | BVAR (other_buffer, field) = BVAR (current_buffer, field); \ |
| 2145 | B_ (current_buffer, field) = tmp##field; \ | 2142 | BVAR (current_buffer, field) = tmp##field; \ |
| 2146 | } while (0) | 2143 | } while (0) |
| 2147 | 2144 | ||
| 2148 | swapfield (own_text, struct buffer_text); | 2145 | swapfield (own_text, struct buffer_text); |
| @@ -2181,8 +2178,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, | |||
| 2181 | swapfield_ (pt_marker, Lisp_Object); | 2178 | swapfield_ (pt_marker, Lisp_Object); |
| 2182 | swapfield_ (begv_marker, Lisp_Object); | 2179 | swapfield_ (begv_marker, Lisp_Object); |
| 2183 | swapfield_ (zv_marker, Lisp_Object); | 2180 | swapfield_ (zv_marker, Lisp_Object); |
| 2184 | B_ (current_buffer, point_before_scroll) = Qnil; | 2181 | BVAR (current_buffer, point_before_scroll) = Qnil; |
| 2185 | B_ (other_buffer, point_before_scroll) = Qnil; | 2182 | BVAR (other_buffer, point_before_scroll) = Qnil; |
| 2186 | 2183 | ||
| 2187 | current_buffer->text->modiff++; other_buffer->text->modiff++; | 2184 | current_buffer->text->modiff++; other_buffer->text->modiff++; |
| 2188 | current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++; | 2185 | current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++; |
| @@ -2256,21 +2253,21 @@ current buffer is cleared. */) | |||
| 2256 | EMACS_INT begv, zv; | 2253 | EMACS_INT begv, zv; |
| 2257 | int narrowed = (BEG != BEGV || Z != ZV); | 2254 | int narrowed = (BEG != BEGV || Z != ZV); |
| 2258 | int modified_p = !NILP (Fbuffer_modified_p (Qnil)); | 2255 | int modified_p = !NILP (Fbuffer_modified_p (Qnil)); |
| 2259 | Lisp_Object old_undo = B_ (current_buffer, undo_list); | 2256 | Lisp_Object old_undo = BVAR (current_buffer, undo_list); |
| 2260 | struct gcpro gcpro1; | 2257 | struct gcpro gcpro1; |
| 2261 | 2258 | ||
| 2262 | if (current_buffer->base_buffer) | 2259 | if (current_buffer->base_buffer) |
| 2263 | error ("Cannot do `set-buffer-multibyte' on an indirect buffer"); | 2260 | error ("Cannot do `set-buffer-multibyte' on an indirect buffer"); |
| 2264 | 2261 | ||
| 2265 | /* Do nothing if nothing actually changes. */ | 2262 | /* Do nothing if nothing actually changes. */ |
| 2266 | if (NILP (flag) == NILP (B_ (current_buffer, enable_multibyte_characters))) | 2263 | if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2267 | return flag; | 2264 | return flag; |
| 2268 | 2265 | ||
| 2269 | GCPRO1 (old_undo); | 2266 | GCPRO1 (old_undo); |
| 2270 | 2267 | ||
| 2271 | /* Don't record these buffer changes. We will put a special undo entry | 2268 | /* Don't record these buffer changes. We will put a special undo entry |
| 2272 | instead. */ | 2269 | instead. */ |
| 2273 | B_ (current_buffer, undo_list) = Qt; | 2270 | BVAR (current_buffer, undo_list) = Qt; |
| 2274 | 2271 | ||
| 2275 | /* If the cached position is for this buffer, clear it out. */ | 2272 | /* If the cached position is for this buffer, clear it out. */ |
| 2276 | clear_charpos_cache (current_buffer); | 2273 | clear_charpos_cache (current_buffer); |
| @@ -2292,7 +2289,7 @@ current buffer is cleared. */) | |||
| 2292 | to calculate the old correspondences. */ | 2289 | to calculate the old correspondences. */ |
| 2293 | set_intervals_multibyte (0); | 2290 | set_intervals_multibyte (0); |
| 2294 | 2291 | ||
| 2295 | B_ (current_buffer, enable_multibyte_characters) = Qnil; | 2292 | BVAR (current_buffer, enable_multibyte_characters) = Qnil; |
| 2296 | 2293 | ||
| 2297 | Z = Z_BYTE; | 2294 | Z = Z_BYTE; |
| 2298 | BEGV = BEGV_BYTE; | 2295 | BEGV = BEGV_BYTE; |
| @@ -2430,7 +2427,7 @@ current buffer is cleared. */) | |||
| 2430 | 2427 | ||
| 2431 | /* Do this first, so that chars_in_text asks the right question. | 2428 | /* Do this first, so that chars_in_text asks the right question. |
| 2432 | set_intervals_multibyte needs it too. */ | 2429 | set_intervals_multibyte needs it too. */ |
| 2433 | B_ (current_buffer, enable_multibyte_characters) = Qt; | 2430 | BVAR (current_buffer, enable_multibyte_characters) = Qt; |
| 2434 | 2431 | ||
| 2435 | GPT_BYTE = advance_to_char_boundary (GPT_BYTE); | 2432 | GPT_BYTE = advance_to_char_boundary (GPT_BYTE); |
| 2436 | GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG; | 2433 | GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG; |
| @@ -2488,7 +2485,7 @@ current buffer is cleared. */) | |||
| 2488 | if (!EQ (old_undo, Qt)) | 2485 | if (!EQ (old_undo, Qt)) |
| 2489 | { | 2486 | { |
| 2490 | /* Represent all the above changes by a special undo entry. */ | 2487 | /* Represent all the above changes by a special undo entry. */ |
| 2491 | B_ (current_buffer, undo_list) = Fcons (list3 (Qapply, | 2488 | BVAR (current_buffer, undo_list) = Fcons (list3 (Qapply, |
| 2492 | intern ("set-buffer-multibyte"), | 2489 | intern ("set-buffer-multibyte"), |
| 2493 | NILP (flag) ? Qt : Qnil), | 2490 | NILP (flag) ? Qt : Qnil), |
| 2494 | old_undo); | 2491 | old_undo); |
| @@ -2504,10 +2501,10 @@ current buffer is cleared. */) | |||
| 2504 | /* Copy this buffer's new multibyte status | 2501 | /* Copy this buffer's new multibyte status |
| 2505 | into all of its indirect buffers. */ | 2502 | into all of its indirect buffers. */ |
| 2506 | for (other = all_buffers; other; other = other->next) | 2503 | for (other = all_buffers; other; other = other->next) |
| 2507 | if (other->base_buffer == current_buffer && !NILP (B_ (other, name))) | 2504 | if (other->base_buffer == current_buffer && !NILP (BVAR (other, name))) |
| 2508 | { | 2505 | { |
| 2509 | B_ (other, enable_multibyte_characters) | 2506 | BVAR (other, enable_multibyte_characters) |
| 2510 | = B_ (current_buffer, enable_multibyte_characters); | 2507 | = BVAR (current_buffer, enable_multibyte_characters); |
| 2511 | other->prevent_redisplay_optimizations_p = 1; | 2508 | other->prevent_redisplay_optimizations_p = 1; |
| 2512 | } | 2509 | } |
| 2513 | 2510 | ||
| @@ -2574,7 +2571,7 @@ swap_out_buffer_local_variables (struct buffer *b) | |||
| 2574 | Lisp_Object oalist, alist, buffer; | 2571 | Lisp_Object oalist, alist, buffer; |
| 2575 | 2572 | ||
| 2576 | XSETBUFFER (buffer, b); | 2573 | XSETBUFFER (buffer, b); |
| 2577 | oalist = B_ (b, local_var_alist); | 2574 | oalist = BVAR (b, local_var_alist); |
| 2578 | 2575 | ||
| 2579 | for (alist = oalist; CONSP (alist); alist = XCDR (alist)) | 2576 | for (alist = oalist; CONSP (alist); alist = XCDR (alist)) |
| 2580 | { | 2577 | { |
| @@ -3078,7 +3075,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str | |||
| 3078 | ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); | 3075 | ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); |
| 3079 | ssl->used++; | 3076 | ssl->used++; |
| 3080 | 3077 | ||
| 3081 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 3078 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3082 | nbytes = SCHARS (str); | 3079 | nbytes = SCHARS (str); |
| 3083 | else if (! STRING_MULTIBYTE (str)) | 3080 | else if (! STRING_MULTIBYTE (str)) |
| 3084 | nbytes = count_size_as_multibyte (SDATA (str), | 3081 | nbytes = count_size_as_multibyte (SDATA (str), |
| @@ -3090,7 +3087,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str | |||
| 3090 | 3087 | ||
| 3091 | if (STRINGP (str2)) | 3088 | if (STRINGP (str2)) |
| 3092 | { | 3089 | { |
| 3093 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 3090 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3094 | nbytes = SCHARS (str2); | 3091 | nbytes = SCHARS (str2); |
| 3095 | else if (! STRING_MULTIBYTE (str2)) | 3092 | else if (! STRING_MULTIBYTE (str2)) |
| 3096 | nbytes = count_size_as_multibyte (SDATA (str2), | 3093 | nbytes = count_size_as_multibyte (SDATA (str2), |
| @@ -3120,7 +3117,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr) | |||
| 3120 | Lisp_Object overlay, window, str; | 3117 | Lisp_Object overlay, window, str; |
| 3121 | struct Lisp_Overlay *ov; | 3118 | struct Lisp_Overlay *ov; |
| 3122 | EMACS_INT startpos, endpos; | 3119 | EMACS_INT startpos, endpos; |
| 3123 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 3120 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 3124 | 3121 | ||
| 3125 | overlay_heads.used = overlay_heads.bytes = 0; | 3122 | overlay_heads.used = overlay_heads.bytes = 0; |
| 3126 | overlay_tails.used = overlay_tails.bytes = 0; | 3123 | overlay_tails.used = overlay_tails.bytes = 0; |
| @@ -4991,9 +4988,9 @@ init_buffer_once (void) | |||
| 4991 | /* Make sure all markable slots in buffer_defaults | 4988 | /* Make sure all markable slots in buffer_defaults |
| 4992 | are initialized reasonably, so mark_buffer won't choke. */ | 4989 | are initialized reasonably, so mark_buffer won't choke. */ |
| 4993 | reset_buffer (&buffer_defaults); | 4990 | reset_buffer (&buffer_defaults); |
| 4994 | eassert (EQ (B_ (&buffer_defaults, name), make_number (0))); | 4991 | eassert (EQ (BVAR (&buffer_defaults, name), make_number (0))); |
| 4995 | reset_buffer_local_variables (&buffer_defaults, 1); | 4992 | reset_buffer_local_variables (&buffer_defaults, 1); |
| 4996 | eassert (EQ (B_ (&buffer_local_symbols, name), make_number (0))); | 4993 | eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0))); |
| 4997 | reset_buffer (&buffer_local_symbols); | 4994 | reset_buffer (&buffer_local_symbols); |
| 4998 | reset_buffer_local_variables (&buffer_local_symbols, 1); | 4995 | reset_buffer_local_variables (&buffer_local_symbols, 1); |
| 4999 | /* Prevent GC from getting confused. */ | 4996 | /* Prevent GC from getting confused. */ |
| @@ -5010,60 +5007,57 @@ init_buffer_once (void) | |||
| 5010 | /* Must do these before making the first buffer! */ | 5007 | /* Must do these before making the first buffer! */ |
| 5011 | 5008 | ||
| 5012 | /* real setup is done in bindings.el */ | 5009 | /* real setup is done in bindings.el */ |
| 5013 | B_ (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); | 5010 | BVAR (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); |
| 5014 | B_ (&buffer_defaults, header_line_format) = Qnil; | 5011 | BVAR (&buffer_defaults, header_line_format) = Qnil; |
| 5015 | B_ (&buffer_defaults, abbrev_mode) = Qnil; | 5012 | BVAR (&buffer_defaults, abbrev_mode) = Qnil; |
| 5016 | B_ (&buffer_defaults, overwrite_mode) = Qnil; | 5013 | BVAR (&buffer_defaults, overwrite_mode) = Qnil; |
| 5017 | B_ (&buffer_defaults, case_fold_search) = Qt; | 5014 | BVAR (&buffer_defaults, case_fold_search) = Qt; |
| 5018 | B_ (&buffer_defaults, auto_fill_function) = Qnil; | 5015 | BVAR (&buffer_defaults, auto_fill_function) = Qnil; |
| 5019 | B_ (&buffer_defaults, selective_display) = Qnil; | 5016 | BVAR (&buffer_defaults, selective_display) = Qnil; |
| 5020 | #ifndef old | 5017 | #ifndef old |
| 5021 | B_ (&buffer_defaults, selective_display_ellipses) = Qt; | 5018 | BVAR (&buffer_defaults, selective_display_ellipses) = Qt; |
| 5022 | #endif | 5019 | #endif |
| 5023 | B_ (&buffer_defaults, abbrev_table) = Qnil; | 5020 | BVAR (&buffer_defaults, abbrev_table) = Qnil; |
| 5024 | B_ (&buffer_defaults, display_table) = Qnil; | 5021 | BVAR (&buffer_defaults, display_table) = Qnil; |
| 5025 | B_ (&buffer_defaults, undo_list) = Qnil; | 5022 | BVAR (&buffer_defaults, undo_list) = Qnil; |
| 5026 | B_ (&buffer_defaults, mark_active) = Qnil; | 5023 | BVAR (&buffer_defaults, mark_active) = Qnil; |
| 5027 | B_ (&buffer_defaults, file_format) = Qnil; | 5024 | BVAR (&buffer_defaults, file_format) = Qnil; |
| 5028 | B_ (&buffer_defaults, auto_save_file_format) = Qt; | 5025 | BVAR (&buffer_defaults, auto_save_file_format) = Qt; |
| 5029 | buffer_defaults.overlays_before = NULL; | 5026 | buffer_defaults.overlays_before = NULL; |
| 5030 | buffer_defaults.overlays_after = NULL; | 5027 | buffer_defaults.overlays_after = NULL; |
| 5031 | buffer_defaults.overlay_center = BEG; | 5028 | buffer_defaults.overlay_center = BEG; |
| 5032 | 5029 | ||
| 5033 | XSETFASTINT (B_ (&buffer_defaults, tab_width), 8); | 5030 | XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8); |
| 5034 | B_ (&buffer_defaults, truncate_lines) = Qnil; | 5031 | BVAR (&buffer_defaults, truncate_lines) = Qnil; |
| 5035 | B_ (&buffer_defaults, word_wrap) = Qnil; | 5032 | BVAR (&buffer_defaults, word_wrap) = Qnil; |
| 5036 | B_ (&buffer_defaults, ctl_arrow) = Qt; | 5033 | BVAR (&buffer_defaults, ctl_arrow) = Qt; |
| 5037 | B_ (&buffer_defaults, bidi_display_reordering) = Qnil; | 5034 | BVAR (&buffer_defaults, bidi_display_reordering) = Qnil; |
| 5038 | B_ (&buffer_defaults, bidi_paragraph_direction) = Qnil; | 5035 | BVAR (&buffer_defaults, bidi_paragraph_direction) = Qnil; |
| 5039 | B_ (&buffer_defaults, cursor_type) = Qt; | 5036 | BVAR (&buffer_defaults, cursor_type) = Qt; |
| 5040 | B_ (&buffer_defaults, extra_line_spacing) = Qnil; | 5037 | BVAR (&buffer_defaults, extra_line_spacing) = Qnil; |
| 5041 | B_ (&buffer_defaults, cursor_in_non_selected_windows) = Qt; | 5038 | BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt; |
| 5042 | 5039 | ||
| 5043 | #ifdef DOS_NT | 5040 | BVAR (&buffer_defaults, enable_multibyte_characters) = Qt; |
| 5044 | B_ (&buffer_defaults, buffer_file_type) = Qnil; /* TEXT */ | 5041 | BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil; |
| 5045 | #endif | 5042 | XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70); |
| 5046 | B_ (&buffer_defaults, enable_multibyte_characters) = Qt; | 5043 | XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0); |
| 5047 | B_ (&buffer_defaults, buffer_file_coding_system) = Qnil; | 5044 | BVAR (&buffer_defaults, cache_long_line_scans) = Qnil; |
| 5048 | XSETFASTINT (B_ (&buffer_defaults, fill_column), 70); | 5045 | BVAR (&buffer_defaults, file_truename) = Qnil; |
| 5049 | XSETFASTINT (B_ (&buffer_defaults, left_margin), 0); | 5046 | XSETFASTINT (BVAR (&buffer_defaults, display_count), 0); |
| 5050 | B_ (&buffer_defaults, cache_long_line_scans) = Qnil; | 5047 | XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0); |
| 5051 | B_ (&buffer_defaults, file_truename) = Qnil; | 5048 | XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0); |
| 5052 | XSETFASTINT (B_ (&buffer_defaults, display_count), 0); | 5049 | BVAR (&buffer_defaults, left_fringe_width) = Qnil; |
| 5053 | XSETFASTINT (B_ (&buffer_defaults, left_margin_cols), 0); | 5050 | BVAR (&buffer_defaults, right_fringe_width) = Qnil; |
| 5054 | XSETFASTINT (B_ (&buffer_defaults, right_margin_cols), 0); | 5051 | BVAR (&buffer_defaults, fringes_outside_margins) = Qnil; |
| 5055 | B_ (&buffer_defaults, left_fringe_width) = Qnil; | 5052 | BVAR (&buffer_defaults, scroll_bar_width) = Qnil; |
| 5056 | B_ (&buffer_defaults, right_fringe_width) = Qnil; | 5053 | BVAR (&buffer_defaults, vertical_scroll_bar_type) = Qt; |
| 5057 | B_ (&buffer_defaults, fringes_outside_margins) = Qnil; | 5054 | BVAR (&buffer_defaults, indicate_empty_lines) = Qnil; |
| 5058 | B_ (&buffer_defaults, scroll_bar_width) = Qnil; | 5055 | BVAR (&buffer_defaults, indicate_buffer_boundaries) = Qnil; |
| 5059 | B_ (&buffer_defaults, vertical_scroll_bar_type) = Qt; | 5056 | BVAR (&buffer_defaults, fringe_indicator_alist) = Qnil; |
| 5060 | B_ (&buffer_defaults, indicate_empty_lines) = Qnil; | 5057 | BVAR (&buffer_defaults, fringe_cursor_alist) = Qnil; |
| 5061 | B_ (&buffer_defaults, indicate_buffer_boundaries) = Qnil; | 5058 | BVAR (&buffer_defaults, scroll_up_aggressively) = Qnil; |
| 5062 | B_ (&buffer_defaults, fringe_indicator_alist) = Qnil; | 5059 | BVAR (&buffer_defaults, scroll_down_aggressively) = Qnil; |
| 5063 | B_ (&buffer_defaults, fringe_cursor_alist) = Qnil; | 5060 | BVAR (&buffer_defaults, display_time) = Qnil; |
| 5064 | B_ (&buffer_defaults, scroll_up_aggressively) = Qnil; | ||
| 5065 | B_ (&buffer_defaults, scroll_down_aggressively) = Qnil; | ||
| 5066 | B_ (&buffer_defaults, display_time) = Qnil; | ||
| 5067 | 5061 | ||
| 5068 | /* Assign the local-flags to the slots that have default values. | 5062 | /* Assign the local-flags to the slots that have default values. |
| 5069 | The local flag is a bit that is used in the buffer | 5063 | The local flag is a bit that is used in the buffer |
| @@ -5075,73 +5069,68 @@ init_buffer_once (void) | |||
| 5075 | 5069 | ||
| 5076 | /* 0 means not a lisp var, -1 means always local, else mask */ | 5070 | /* 0 means not a lisp var, -1 means always local, else mask */ |
| 5077 | memset (&buffer_local_flags, 0, sizeof buffer_local_flags); | 5071 | memset (&buffer_local_flags, 0, sizeof buffer_local_flags); |
| 5078 | XSETINT (B_ (&buffer_local_flags, filename), -1); | 5072 | XSETINT (BVAR (&buffer_local_flags, filename), -1); |
| 5079 | XSETINT (B_ (&buffer_local_flags, directory), -1); | 5073 | XSETINT (BVAR (&buffer_local_flags, directory), -1); |
| 5080 | XSETINT (B_ (&buffer_local_flags, backed_up), -1); | 5074 | XSETINT (BVAR (&buffer_local_flags, backed_up), -1); |
| 5081 | XSETINT (B_ (&buffer_local_flags, save_length), -1); | 5075 | XSETINT (BVAR (&buffer_local_flags, save_length), -1); |
| 5082 | XSETINT (B_ (&buffer_local_flags, auto_save_file_name), -1); | 5076 | XSETINT (BVAR (&buffer_local_flags, auto_save_file_name), -1); |
| 5083 | XSETINT (B_ (&buffer_local_flags, read_only), -1); | 5077 | XSETINT (BVAR (&buffer_local_flags, read_only), -1); |
| 5084 | XSETINT (B_ (&buffer_local_flags, major_mode), -1); | 5078 | XSETINT (BVAR (&buffer_local_flags, major_mode), -1); |
| 5085 | XSETINT (B_ (&buffer_local_flags, mode_name), -1); | 5079 | XSETINT (BVAR (&buffer_local_flags, mode_name), -1); |
| 5086 | XSETINT (B_ (&buffer_local_flags, undo_list), -1); | 5080 | XSETINT (BVAR (&buffer_local_flags, undo_list), -1); |
| 5087 | XSETINT (B_ (&buffer_local_flags, mark_active), -1); | 5081 | XSETINT (BVAR (&buffer_local_flags, mark_active), -1); |
| 5088 | XSETINT (B_ (&buffer_local_flags, point_before_scroll), -1); | 5082 | XSETINT (BVAR (&buffer_local_flags, point_before_scroll), -1); |
| 5089 | XSETINT (B_ (&buffer_local_flags, file_truename), -1); | 5083 | XSETINT (BVAR (&buffer_local_flags, file_truename), -1); |
| 5090 | XSETINT (B_ (&buffer_local_flags, invisibility_spec), -1); | 5084 | XSETINT (BVAR (&buffer_local_flags, invisibility_spec), -1); |
| 5091 | XSETINT (B_ (&buffer_local_flags, file_format), -1); | 5085 | XSETINT (BVAR (&buffer_local_flags, file_format), -1); |
| 5092 | XSETINT (B_ (&buffer_local_flags, auto_save_file_format), -1); | 5086 | XSETINT (BVAR (&buffer_local_flags, auto_save_file_format), -1); |
| 5093 | XSETINT (B_ (&buffer_local_flags, display_count), -1); | 5087 | XSETINT (BVAR (&buffer_local_flags, display_count), -1); |
| 5094 | XSETINT (B_ (&buffer_local_flags, display_time), -1); | 5088 | XSETINT (BVAR (&buffer_local_flags, display_time), -1); |
| 5095 | XSETINT (B_ (&buffer_local_flags, enable_multibyte_characters), -1); | 5089 | XSETINT (BVAR (&buffer_local_flags, enable_multibyte_characters), -1); |
| 5096 | 5090 | ||
| 5097 | idx = 1; | 5091 | idx = 1; |
| 5098 | XSETFASTINT (B_ (&buffer_local_flags, mode_line_format), idx); ++idx; | 5092 | XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; |
| 5099 | XSETFASTINT (B_ (&buffer_local_flags, abbrev_mode), idx); ++idx; | 5093 | XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx; |
| 5100 | XSETFASTINT (B_ (&buffer_local_flags, overwrite_mode), idx); ++idx; | 5094 | XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx; |
| 5101 | XSETFASTINT (B_ (&buffer_local_flags, case_fold_search), idx); ++idx; | 5095 | XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx; |
| 5102 | XSETFASTINT (B_ (&buffer_local_flags, auto_fill_function), idx); ++idx; | 5096 | XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx; |
| 5103 | XSETFASTINT (B_ (&buffer_local_flags, selective_display), idx); ++idx; | 5097 | XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx; |
| 5104 | #ifndef old | 5098 | #ifndef old |
| 5105 | XSETFASTINT (B_ (&buffer_local_flags, selective_display_ellipses), idx); ++idx; | 5099 | XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx; |
| 5106 | #endif | ||
| 5107 | XSETFASTINT (B_ (&buffer_local_flags, tab_width), idx); ++idx; | ||
| 5108 | XSETFASTINT (B_ (&buffer_local_flags, truncate_lines), idx); ++idx; | ||
| 5109 | XSETFASTINT (B_ (&buffer_local_flags, word_wrap), idx); ++idx; | ||
| 5110 | XSETFASTINT (B_ (&buffer_local_flags, ctl_arrow), idx); ++idx; | ||
| 5111 | XSETFASTINT (B_ (&buffer_local_flags, fill_column), idx); ++idx; | ||
| 5112 | XSETFASTINT (B_ (&buffer_local_flags, left_margin), idx); ++idx; | ||
| 5113 | XSETFASTINT (B_ (&buffer_local_flags, abbrev_table), idx); ++idx; | ||
| 5114 | XSETFASTINT (B_ (&buffer_local_flags, display_table), idx); ++idx; | ||
| 5115 | #ifdef DOS_NT | ||
| 5116 | XSETFASTINT (B_ (&buffer_local_flags, buffer_file_type), idx); | ||
| 5117 | /* Make this one a permanent local. */ | ||
| 5118 | buffer_permanent_local_flags[idx++] = 1; | ||
| 5119 | #endif | 5100 | #endif |
| 5120 | XSETFASTINT (B_ (&buffer_local_flags, syntax_table), idx); ++idx; | 5101 | XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx; |
| 5121 | XSETFASTINT (B_ (&buffer_local_flags, cache_long_line_scans), idx); ++idx; | 5102 | XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx; |
| 5122 | XSETFASTINT (B_ (&buffer_local_flags, category_table), idx); ++idx; | 5103 | XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx; |
| 5123 | XSETFASTINT (B_ (&buffer_local_flags, bidi_display_reordering), idx); ++idx; | 5104 | XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx; |
| 5124 | XSETFASTINT (B_ (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; | 5105 | XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx; |
| 5125 | XSETFASTINT (B_ (&buffer_local_flags, buffer_file_coding_system), idx); | 5106 | XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx; |
| 5107 | XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx; | ||
| 5108 | XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx; | ||
| 5109 | XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx; | ||
| 5110 | XSETFASTINT (BVAR (&buffer_local_flags, cache_long_line_scans), idx); ++idx; | ||
| 5111 | XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; | ||
| 5112 | XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; | ||
| 5113 | XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; | ||
| 5114 | XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); | ||
| 5126 | /* Make this one a permanent local. */ | 5115 | /* Make this one a permanent local. */ |
| 5127 | buffer_permanent_local_flags[idx++] = 1; | 5116 | buffer_permanent_local_flags[idx++] = 1; |
| 5128 | XSETFASTINT (B_ (&buffer_local_flags, left_margin_cols), idx); ++idx; | 5117 | XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx; |
| 5129 | XSETFASTINT (B_ (&buffer_local_flags, right_margin_cols), idx); ++idx; | 5118 | XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx; |
| 5130 | XSETFASTINT (B_ (&buffer_local_flags, left_fringe_width), idx); ++idx; | 5119 | XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx; |
| 5131 | XSETFASTINT (B_ (&buffer_local_flags, right_fringe_width), idx); ++idx; | 5120 | XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx; |
| 5132 | XSETFASTINT (B_ (&buffer_local_flags, fringes_outside_margins), idx); ++idx; | 5121 | XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx; |
| 5133 | XSETFASTINT (B_ (&buffer_local_flags, scroll_bar_width), idx); ++idx; | 5122 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx; |
| 5134 | XSETFASTINT (B_ (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; | 5123 | XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; |
| 5135 | XSETFASTINT (B_ (&buffer_local_flags, indicate_empty_lines), idx); ++idx; | 5124 | XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx; |
| 5136 | XSETFASTINT (B_ (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; | 5125 | XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; |
| 5137 | XSETFASTINT (B_ (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; | 5126 | XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; |
| 5138 | XSETFASTINT (B_ (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; | 5127 | XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; |
| 5139 | XSETFASTINT (B_ (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; | 5128 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; |
| 5140 | XSETFASTINT (B_ (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; | 5129 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; |
| 5141 | XSETFASTINT (B_ (&buffer_local_flags, header_line_format), idx); ++idx; | 5130 | XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx; |
| 5142 | XSETFASTINT (B_ (&buffer_local_flags, cursor_type), idx); ++idx; | 5131 | XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx; |
| 5143 | XSETFASTINT (B_ (&buffer_local_flags, extra_line_spacing), idx); ++idx; | 5132 | XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx; |
| 5144 | XSETFASTINT (B_ (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; | 5133 | XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; |
| 5145 | 5134 | ||
| 5146 | /* Need more room? */ | 5135 | /* Need more room? */ |
| 5147 | if (idx >= MAX_PER_BUFFER_VARS) | 5136 | if (idx >= MAX_PER_BUFFER_VARS) |
| @@ -5155,7 +5144,7 @@ init_buffer_once (void) | |||
| 5155 | QSFundamental = make_pure_c_string ("Fundamental"); | 5144 | QSFundamental = make_pure_c_string ("Fundamental"); |
| 5156 | 5145 | ||
| 5157 | Qfundamental_mode = intern_c_string ("fundamental-mode"); | 5146 | Qfundamental_mode = intern_c_string ("fundamental-mode"); |
| 5158 | B_ (&buffer_defaults, major_mode) = Qfundamental_mode; | 5147 | BVAR (&buffer_defaults, major_mode) = Qfundamental_mode; |
| 5159 | 5148 | ||
| 5160 | Qmode_class = intern_c_string ("mode-class"); | 5149 | Qmode_class = intern_c_string ("mode-class"); |
| 5161 | 5150 | ||
| @@ -5198,7 +5187,7 @@ init_buffer (void) | |||
| 5198 | #endif /* USE_MMAP_FOR_BUFFERS */ | 5187 | #endif /* USE_MMAP_FOR_BUFFERS */ |
| 5199 | 5188 | ||
| 5200 | Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); | 5189 | Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); |
| 5201 | if (NILP (B_ (&buffer_defaults, enable_multibyte_characters))) | 5190 | if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) |
| 5202 | Fset_buffer_multibyte (Qnil); | 5191 | Fset_buffer_multibyte (Qnil); |
| 5203 | 5192 | ||
| 5204 | pwd = get_current_dir_name (); | 5193 | pwd = get_current_dir_name (); |
| @@ -5219,28 +5208,28 @@ init_buffer (void) | |||
| 5219 | pwd[len + 1] = '\0'; | 5208 | pwd[len + 1] = '\0'; |
| 5220 | } | 5209 | } |
| 5221 | 5210 | ||
| 5222 | B_ (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); | 5211 | BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); |
| 5223 | if (! NILP (B_ (&buffer_defaults, enable_multibyte_characters))) | 5212 | if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) |
| 5224 | /* At this moment, we still don't know how to decode the | 5213 | /* At this moment, we still don't know how to decode the |
| 5225 | directory name. So, we keep the bytes in multibyte form so | 5214 | directory name. So, we keep the bytes in multibyte form so |
| 5226 | that ENCODE_FILE correctly gets the original bytes. */ | 5215 | that ENCODE_FILE correctly gets the original bytes. */ |
| 5227 | B_ (current_buffer, directory) | 5216 | BVAR (current_buffer, directory) |
| 5228 | = string_to_multibyte (B_ (current_buffer, directory)); | 5217 | = string_to_multibyte (BVAR (current_buffer, directory)); |
| 5229 | 5218 | ||
| 5230 | /* Add /: to the front of the name | 5219 | /* Add /: to the front of the name |
| 5231 | if it would otherwise be treated as magic. */ | 5220 | if it would otherwise be treated as magic. */ |
| 5232 | temp = Ffind_file_name_handler (B_ (current_buffer, directory), Qt); | 5221 | temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt); |
| 5233 | if (! NILP (temp) | 5222 | if (! NILP (temp) |
| 5234 | /* If the default dir is just /, TEMP is non-nil | 5223 | /* If the default dir is just /, TEMP is non-nil |
| 5235 | because of the ange-ftp completion handler. | 5224 | because of the ange-ftp completion handler. |
| 5236 | However, it is not necessary to turn / into /:/. | 5225 | However, it is not necessary to turn / into /:/. |
| 5237 | So avoid doing that. */ | 5226 | So avoid doing that. */ |
| 5238 | && strcmp ("/", SSDATA (B_ (current_buffer, directory)))) | 5227 | && strcmp ("/", SSDATA (BVAR (current_buffer, directory)))) |
| 5239 | B_ (current_buffer, directory) | 5228 | BVAR (current_buffer, directory) |
| 5240 | = concat2 (build_string ("/:"), B_ (current_buffer, directory)); | 5229 | = concat2 (build_string ("/:"), BVAR (current_buffer, directory)); |
| 5241 | 5230 | ||
| 5242 | temp = get_minibuffer (0); | 5231 | temp = get_minibuffer (0); |
| 5243 | B_ (XBUFFER (temp), directory) = B_ (current_buffer, directory); | 5232 | BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory); |
| 5244 | 5233 | ||
| 5245 | free (pwd); | 5234 | free (pwd); |
| 5246 | } | 5235 | } |
| @@ -5415,14 +5404,6 @@ This is the same as (default-value 'tab-width). */); | |||
| 5415 | doc: /* Default value of `case-fold-search' for buffers that don't override it. | 5404 | doc: /* Default value of `case-fold-search' for buffers that don't override it. |
| 5416 | This is the same as (default-value 'case-fold-search). */); | 5405 | This is the same as (default-value 'case-fold-search). */); |
| 5417 | 5406 | ||
| 5418 | #ifdef DOS_NT | ||
| 5419 | DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-type", | ||
| 5420 | buffer_file_type, | ||
| 5421 | doc: /* Default file type for buffers that do not override it. | ||
| 5422 | This is the same as (default-value 'buffer-file-type). | ||
| 5423 | The file type is nil for text, t for binary. */); | ||
| 5424 | #endif | ||
| 5425 | |||
| 5426 | DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width", | 5407 | DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width", |
| 5427 | left_margin_cols, | 5408 | left_margin_cols, |
| 5428 | doc: /* Default value of `left-margin-width' for buffers that don't override it. | 5409 | doc: /* Default value of `left-margin-width' for buffers that don't override it. |
| @@ -5491,13 +5472,13 @@ This value applies in buffers that don't have their own local values. | |||
| 5491 | This is the same as (default-value 'scroll-down-aggressively). */); | 5472 | This is the same as (default-value 'scroll-down-aggressively). */); |
| 5492 | 5473 | ||
| 5493 | DEFVAR_PER_BUFFER ("header-line-format", | 5474 | DEFVAR_PER_BUFFER ("header-line-format", |
| 5494 | &B_ (current_buffer, header_line_format), | 5475 | &BVAR (current_buffer, header_line_format), |
| 5495 | Qnil, | 5476 | Qnil, |
| 5496 | doc: /* Analogous to `mode-line-format', but controls the header line. | 5477 | doc: /* Analogous to `mode-line-format', but controls the header line. |
| 5497 | The header line appears, optionally, at the top of a window; | 5478 | The header line appears, optionally, at the top of a window; |
| 5498 | the mode line appears at the bottom. */); | 5479 | the mode line appears at the bottom. */); |
| 5499 | 5480 | ||
| 5500 | DEFVAR_PER_BUFFER ("mode-line-format", &B_ (current_buffer, mode_line_format), | 5481 | DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format), |
| 5501 | Qnil, | 5482 | Qnil, |
| 5502 | doc: /* Template for displaying mode line for current buffer. | 5483 | doc: /* Template for displaying mode line for current buffer. |
| 5503 | Each buffer has its own value of this variable. | 5484 | Each buffer has its own value of this variable. |
| @@ -5554,7 +5535,7 @@ Decimal digits after the % specify field width to which to pad. */); | |||
| 5554 | DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode, | 5535 | DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode, |
| 5555 | doc: /* *Value of `major-mode' for new buffers. */); | 5536 | doc: /* *Value of `major-mode' for new buffers. */); |
| 5556 | 5537 | ||
| 5557 | DEFVAR_PER_BUFFER ("major-mode", &B_ (current_buffer, major_mode), | 5538 | DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode), |
| 5558 | make_number (Lisp_Symbol), | 5539 | make_number (Lisp_Symbol), |
| 5559 | doc: /* Symbol for current buffer's major mode. | 5540 | doc: /* Symbol for current buffer's major mode. |
| 5560 | The default value (normally `fundamental-mode') affects new buffers. | 5541 | The default value (normally `fundamental-mode') affects new buffers. |
| @@ -5567,46 +5548,46 @@ the buffer. Thus, the mode and its hooks should not expect certain | |||
| 5567 | variables such as `buffer-read-only' and `buffer-file-coding-system' | 5548 | variables such as `buffer-read-only' and `buffer-file-coding-system' |
| 5568 | to be set up. */); | 5549 | to be set up. */); |
| 5569 | 5550 | ||
| 5570 | DEFVAR_PER_BUFFER ("mode-name", &B_ (current_buffer, mode_name), | 5551 | DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name), |
| 5571 | Qnil, | 5552 | Qnil, |
| 5572 | doc: /* Pretty name of current buffer's major mode. | 5553 | doc: /* Pretty name of current buffer's major mode. |
| 5573 | Usually a string, but can use any of the constructs for `mode-line-format', | 5554 | Usually a string, but can use any of the constructs for `mode-line-format', |
| 5574 | which see. | 5555 | which see. |
| 5575 | Format with `format-mode-line' to produce a string value. */); | 5556 | Format with `format-mode-line' to produce a string value. */); |
| 5576 | 5557 | ||
| 5577 | DEFVAR_PER_BUFFER ("local-abbrev-table", &B_ (current_buffer, abbrev_table), Qnil, | 5558 | DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil, |
| 5578 | doc: /* Local (mode-specific) abbrev table of current buffer. */); | 5559 | doc: /* Local (mode-specific) abbrev table of current buffer. */); |
| 5579 | 5560 | ||
| 5580 | DEFVAR_PER_BUFFER ("abbrev-mode", &B_ (current_buffer, abbrev_mode), Qnil, | 5561 | DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil, |
| 5581 | doc: /* Non-nil if Abbrev mode is enabled. | 5562 | doc: /* Non-nil if Abbrev mode is enabled. |
| 5582 | Use the command `abbrev-mode' to change this variable. */); | 5563 | Use the command `abbrev-mode' to change this variable. */); |
| 5583 | 5564 | ||
| 5584 | DEFVAR_PER_BUFFER ("case-fold-search", &B_ (current_buffer, case_fold_search), | 5565 | DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search), |
| 5585 | Qnil, | 5566 | Qnil, |
| 5586 | doc: /* *Non-nil if searches and matches should ignore case. */); | 5567 | doc: /* *Non-nil if searches and matches should ignore case. */); |
| 5587 | 5568 | ||
| 5588 | DEFVAR_PER_BUFFER ("fill-column", &B_ (current_buffer, fill_column), | 5569 | DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column), |
| 5589 | make_number (LISP_INT_TAG), | 5570 | make_number (LISP_INT_TAG), |
| 5590 | doc: /* *Column beyond which automatic line-wrapping should happen. | 5571 | doc: /* *Column beyond which automatic line-wrapping should happen. |
| 5591 | Interactively, you can set the buffer local value using \\[set-fill-column]. */); | 5572 | Interactively, you can set the buffer local value using \\[set-fill-column]. */); |
| 5592 | 5573 | ||
| 5593 | DEFVAR_PER_BUFFER ("left-margin", &B_ (current_buffer, left_margin), | 5574 | DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin), |
| 5594 | make_number (LISP_INT_TAG), | 5575 | make_number (LISP_INT_TAG), |
| 5595 | doc: /* *Column for the default `indent-line-function' to indent to. | 5576 | doc: /* *Column for the default `indent-line-function' to indent to. |
| 5596 | Linefeed indents to this column in Fundamental mode. */); | 5577 | Linefeed indents to this column in Fundamental mode. */); |
| 5597 | 5578 | ||
| 5598 | DEFVAR_PER_BUFFER ("tab-width", &B_ (current_buffer, tab_width), | 5579 | DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width), |
| 5599 | make_number (LISP_INT_TAG), | 5580 | make_number (LISP_INT_TAG), |
| 5600 | doc: /* *Distance between tab stops (for display of tab characters), in columns. */); | 5581 | doc: /* *Distance between tab stops (for display of tab characters), in columns. */); |
| 5601 | 5582 | ||
| 5602 | DEFVAR_PER_BUFFER ("ctl-arrow", &B_ (current_buffer, ctl_arrow), Qnil, | 5583 | DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil, |
| 5603 | doc: /* *Non-nil means display control chars with uparrow. | 5584 | doc: /* *Non-nil means display control chars with uparrow. |
| 5604 | A value of nil means use backslash and octal digits. | 5585 | A value of nil means use backslash and octal digits. |
| 5605 | This variable does not apply to characters whose display is specified | 5586 | This variable does not apply to characters whose display is specified |
| 5606 | in the current display table (if there is one). */); | 5587 | in the current display table (if there is one). */); |
| 5607 | 5588 | ||
| 5608 | DEFVAR_PER_BUFFER ("enable-multibyte-characters", | 5589 | DEFVAR_PER_BUFFER ("enable-multibyte-characters", |
| 5609 | &B_ (current_buffer, enable_multibyte_characters), | 5590 | &BVAR (current_buffer, enable_multibyte_characters), |
| 5610 | Qnil, | 5591 | Qnil, |
| 5611 | doc: /* Non-nil means the buffer contents are regarded as multi-byte characters. | 5592 | doc: /* Non-nil means the buffer contents are regarded as multi-byte characters. |
| 5612 | Otherwise they are regarded as unibyte. This affects the display, | 5593 | Otherwise they are regarded as unibyte. This affects the display, |
| @@ -5620,7 +5601,7 @@ See also variable `default-enable-multibyte-characters' and Info node | |||
| 5620 | XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; | 5601 | XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; |
| 5621 | 5602 | ||
| 5622 | DEFVAR_PER_BUFFER ("buffer-file-coding-system", | 5603 | DEFVAR_PER_BUFFER ("buffer-file-coding-system", |
| 5623 | &B_ (current_buffer, buffer_file_coding_system), Qnil, | 5604 | &BVAR (current_buffer, buffer_file_coding_system), Qnil, |
| 5624 | doc: /* Coding system to be used for encoding the buffer contents on saving. | 5605 | doc: /* Coding system to be used for encoding the buffer contents on saving. |
| 5625 | This variable applies to saving the buffer, and also to `write-region' | 5606 | This variable applies to saving the buffer, and also to `write-region' |
| 5626 | and other functions that use `write-region'. | 5607 | and other functions that use `write-region'. |
| @@ -5638,11 +5619,11 @@ The variable `coding-system-for-write', if non-nil, overrides this variable. | |||
| 5638 | This variable is never applied to a way of decoding a file while reading it. */); | 5619 | This variable is never applied to a way of decoding a file while reading it. */); |
| 5639 | 5620 | ||
| 5640 | DEFVAR_PER_BUFFER ("bidi-display-reordering", | 5621 | DEFVAR_PER_BUFFER ("bidi-display-reordering", |
| 5641 | &B_ (current_buffer, bidi_display_reordering), Qnil, | 5622 | &BVAR (current_buffer, bidi_display_reordering), Qnil, |
| 5642 | doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); | 5623 | doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); |
| 5643 | 5624 | ||
| 5644 | DEFVAR_PER_BUFFER ("bidi-paragraph-direction", | 5625 | DEFVAR_PER_BUFFER ("bidi-paragraph-direction", |
| 5645 | &B_ (current_buffer, bidi_paragraph_direction), Qnil, | 5626 | &BVAR (current_buffer, bidi_paragraph_direction), Qnil, |
| 5646 | doc: /* *If non-nil, forces directionality of text paragraphs in the buffer. | 5627 | doc: /* *If non-nil, forces directionality of text paragraphs in the buffer. |
| 5647 | 5628 | ||
| 5648 | If this is nil (the default), the direction of each paragraph is | 5629 | If this is nil (the default), the direction of each paragraph is |
| @@ -5653,7 +5634,7 @@ Any other value is treated as nil. | |||
| 5653 | This variable has no effect unless the buffer's value of | 5634 | This variable has no effect unless the buffer's value of |
| 5654 | \`bidi-display-reordering' is non-nil. */); | 5635 | \`bidi-display-reordering' is non-nil. */); |
| 5655 | 5636 | ||
| 5656 | DEFVAR_PER_BUFFER ("truncate-lines", &B_ (current_buffer, truncate_lines), Qnil, | 5637 | DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil, |
| 5657 | doc: /* *Non-nil means do not display continuation lines. | 5638 | doc: /* *Non-nil means do not display continuation lines. |
| 5658 | Instead, give each line of text just one screen line. | 5639 | Instead, give each line of text just one screen line. |
| 5659 | 5640 | ||
| @@ -5661,7 +5642,7 @@ Note that this is overridden by the variable | |||
| 5661 | `truncate-partial-width-windows' if that variable is non-nil | 5642 | `truncate-partial-width-windows' if that variable is non-nil |
| 5662 | and this buffer is not full-frame width. */); | 5643 | and this buffer is not full-frame width. */); |
| 5663 | 5644 | ||
| 5664 | DEFVAR_PER_BUFFER ("word-wrap", &B_ (current_buffer, word_wrap), Qnil, | 5645 | DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil, |
| 5665 | doc: /* *Non-nil means to use word-wrapping for continuation lines. | 5646 | doc: /* *Non-nil means to use word-wrapping for continuation lines. |
| 5666 | When word-wrapping is on, continuation lines are wrapped at the space | 5647 | When word-wrapping is on, continuation lines are wrapped at the space |
| 5667 | or tab character nearest to the right window edge. | 5648 | or tab character nearest to the right window edge. |
| @@ -5673,21 +5654,12 @@ word-wrapping, you might want to reduce the value of | |||
| 5673 | `truncate-partial-width-windows', since wrapping can make text readable | 5654 | `truncate-partial-width-windows', since wrapping can make text readable |
| 5674 | in narrower windows. */); | 5655 | in narrower windows. */); |
| 5675 | 5656 | ||
| 5676 | #ifdef DOS_NT | 5657 | DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), |
| 5677 | DEFVAR_PER_BUFFER ("buffer-file-type", &B_ (current_buffer, buffer_file_type), | ||
| 5678 | Qnil, | ||
| 5679 | doc: /* Non-nil if the visited file is a binary file. | ||
| 5680 | This variable is meaningful on MS-DOG and Windows NT. | ||
| 5681 | On those systems, it is automatically local in every buffer. | ||
| 5682 | On other systems, this variable is normally always nil. */); | ||
| 5683 | #endif | ||
| 5684 | |||
| 5685 | DEFVAR_PER_BUFFER ("default-directory", &B_ (current_buffer, directory), | ||
| 5686 | make_number (Lisp_String), | 5658 | make_number (Lisp_String), |
| 5687 | doc: /* Name of default directory of current buffer. Should end with slash. | 5659 | doc: /* Name of default directory of current buffer. Should end with slash. |
| 5688 | To interactively change the default directory, use command `cd'. */); | 5660 | To interactively change the default directory, use command `cd'. */); |
| 5689 | 5661 | ||
| 5690 | DEFVAR_PER_BUFFER ("auto-fill-function", &B_ (current_buffer, auto_fill_function), | 5662 | DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function), |
| 5691 | Qnil, | 5663 | Qnil, |
| 5692 | doc: /* Function called (if non-nil) to perform auto-fill. | 5664 | doc: /* Function called (if non-nil) to perform auto-fill. |
| 5693 | It is called after self-inserting any character specified in | 5665 | It is called after self-inserting any character specified in |
| @@ -5695,30 +5667,30 @@ the `auto-fill-chars' table. | |||
| 5695 | NOTE: This variable is not a hook; | 5667 | NOTE: This variable is not a hook; |
| 5696 | its value may not be a list of functions. */); | 5668 | its value may not be a list of functions. */); |
| 5697 | 5669 | ||
| 5698 | DEFVAR_PER_BUFFER ("buffer-file-name", &B_ (current_buffer, filename), | 5670 | DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename), |
| 5699 | make_number (Lisp_String), | 5671 | make_number (Lisp_String), |
| 5700 | doc: /* Name of file visited in current buffer, or nil if not visiting a file. */); | 5672 | doc: /* Name of file visited in current buffer, or nil if not visiting a file. */); |
| 5701 | 5673 | ||
| 5702 | DEFVAR_PER_BUFFER ("buffer-file-truename", &B_ (current_buffer, file_truename), | 5674 | DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename), |
| 5703 | make_number (Lisp_String), | 5675 | make_number (Lisp_String), |
| 5704 | doc: /* Abbreviated truename of file visited in current buffer, or nil if none. | 5676 | doc: /* Abbreviated truename of file visited in current buffer, or nil if none. |
| 5705 | The truename of a file is calculated by `file-truename' | 5677 | The truename of a file is calculated by `file-truename' |
| 5706 | and then abbreviated with `abbreviate-file-name'. */); | 5678 | and then abbreviated with `abbreviate-file-name'. */); |
| 5707 | 5679 | ||
| 5708 | DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", | 5680 | DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", |
| 5709 | &B_ (current_buffer, auto_save_file_name), | 5681 | &BVAR (current_buffer, auto_save_file_name), |
| 5710 | make_number (Lisp_String), | 5682 | make_number (Lisp_String), |
| 5711 | doc: /* Name of file for auto-saving current buffer. | 5683 | doc: /* Name of file for auto-saving current buffer. |
| 5712 | If it is nil, that means don't auto-save this buffer. */); | 5684 | If it is nil, that means don't auto-save this buffer. */); |
| 5713 | 5685 | ||
| 5714 | DEFVAR_PER_BUFFER ("buffer-read-only", &B_ (current_buffer, read_only), Qnil, | 5686 | DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil, |
| 5715 | doc: /* Non-nil if this buffer is read-only. */); | 5687 | doc: /* Non-nil if this buffer is read-only. */); |
| 5716 | 5688 | ||
| 5717 | DEFVAR_PER_BUFFER ("buffer-backed-up", &B_ (current_buffer, backed_up), Qnil, | 5689 | DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil, |
| 5718 | doc: /* Non-nil if this buffer's file has been backed up. | 5690 | doc: /* Non-nil if this buffer's file has been backed up. |
| 5719 | Backing up is done before the first time the file is saved. */); | 5691 | Backing up is done before the first time the file is saved. */); |
| 5720 | 5692 | ||
| 5721 | DEFVAR_PER_BUFFER ("buffer-saved-size", &B_ (current_buffer, save_length), | 5693 | DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length), |
| 5722 | make_number (LISP_INT_TAG), | 5694 | make_number (LISP_INT_TAG), |
| 5723 | doc: /* Length of current buffer when last read in, saved or auto-saved. | 5695 | doc: /* Length of current buffer when last read in, saved or auto-saved. |
| 5724 | 0 initially. | 5696 | 0 initially. |
| @@ -5728,7 +5700,7 @@ If you set this to -2, that means don't turn off auto-saving in this buffer | |||
| 5728 | if its text size shrinks. If you use `buffer-swap-text' on a buffer, | 5700 | if its text size shrinks. If you use `buffer-swap-text' on a buffer, |
| 5729 | you probably should set this to -2 in that buffer. */); | 5701 | you probably should set this to -2 in that buffer. */); |
| 5730 | 5702 | ||
| 5731 | DEFVAR_PER_BUFFER ("selective-display", &B_ (current_buffer, selective_display), | 5703 | DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display), |
| 5732 | Qnil, | 5704 | Qnil, |
| 5733 | doc: /* Non-nil enables selective display. | 5705 | doc: /* Non-nil enables selective display. |
| 5734 | An integer N as value means display only lines | 5706 | An integer N as value means display only lines |
| @@ -5739,12 +5711,12 @@ in a file, save the ^M as a newline. */); | |||
| 5739 | 5711 | ||
| 5740 | #ifndef old | 5712 | #ifndef old |
| 5741 | DEFVAR_PER_BUFFER ("selective-display-ellipses", | 5713 | DEFVAR_PER_BUFFER ("selective-display-ellipses", |
| 5742 | &B_ (current_buffer, selective_display_ellipses), | 5714 | &BVAR (current_buffer, selective_display_ellipses), |
| 5743 | Qnil, | 5715 | Qnil, |
| 5744 | doc: /* Non-nil means display ... on previous line when a line is invisible. */); | 5716 | doc: /* Non-nil means display ... on previous line when a line is invisible. */); |
| 5745 | #endif | 5717 | #endif |
| 5746 | 5718 | ||
| 5747 | DEFVAR_PER_BUFFER ("overwrite-mode", &B_ (current_buffer, overwrite_mode), Qnil, | 5719 | DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil, |
| 5748 | doc: /* Non-nil if self-insertion should replace existing text. | 5720 | doc: /* Non-nil if self-insertion should replace existing text. |
| 5749 | The value should be one of `overwrite-mode-textual', | 5721 | The value should be one of `overwrite-mode-textual', |
| 5750 | `overwrite-mode-binary', or nil. | 5722 | `overwrite-mode-binary', or nil. |
| @@ -5753,7 +5725,7 @@ inserts at the end of a line, and inserts when point is before a tab, | |||
| 5753 | until the tab is filled in. | 5725 | until the tab is filled in. |
| 5754 | If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */); | 5726 | If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */); |
| 5755 | 5727 | ||
| 5756 | DEFVAR_PER_BUFFER ("buffer-display-table", &B_ (current_buffer, display_table), | 5728 | DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table), |
| 5757 | Qnil, | 5729 | Qnil, |
| 5758 | doc: /* Display table that controls display of the contents of current buffer. | 5730 | doc: /* Display table that controls display of the contents of current buffer. |
| 5759 | 5731 | ||
| @@ -5790,39 +5762,39 @@ In addition, a char-table has six extra slots to control the display of: | |||
| 5790 | 5762 | ||
| 5791 | See also the functions `display-table-slot' and `set-display-table-slot'. */); | 5763 | See also the functions `display-table-slot' and `set-display-table-slot'. */); |
| 5792 | 5764 | ||
| 5793 | DEFVAR_PER_BUFFER ("left-margin-width", &B_ (current_buffer, left_margin_cols), | 5765 | DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), |
| 5794 | Qnil, | 5766 | Qnil, |
| 5795 | doc: /* *Width of left marginal area for display of a buffer. | 5767 | doc: /* *Width of left marginal area for display of a buffer. |
| 5796 | A value of nil means no marginal area. */); | 5768 | A value of nil means no marginal area. */); |
| 5797 | 5769 | ||
| 5798 | DEFVAR_PER_BUFFER ("right-margin-width", &B_ (current_buffer, right_margin_cols), | 5770 | DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), |
| 5799 | Qnil, | 5771 | Qnil, |
| 5800 | doc: /* *Width of right marginal area for display of a buffer. | 5772 | doc: /* *Width of right marginal area for display of a buffer. |
| 5801 | A value of nil means no marginal area. */); | 5773 | A value of nil means no marginal area. */); |
| 5802 | 5774 | ||
| 5803 | DEFVAR_PER_BUFFER ("left-fringe-width", &B_ (current_buffer, left_fringe_width), | 5775 | DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), |
| 5804 | Qnil, | 5776 | Qnil, |
| 5805 | doc: /* *Width of this buffer's left fringe (in pixels). | 5777 | doc: /* *Width of this buffer's left fringe (in pixels). |
| 5806 | A value of 0 means no left fringe is shown in this buffer's window. | 5778 | A value of 0 means no left fringe is shown in this buffer's window. |
| 5807 | A value of nil means to use the left fringe width from the window's frame. */); | 5779 | A value of nil means to use the left fringe width from the window's frame. */); |
| 5808 | 5780 | ||
| 5809 | DEFVAR_PER_BUFFER ("right-fringe-width", &B_ (current_buffer, right_fringe_width), | 5781 | DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), |
| 5810 | Qnil, | 5782 | Qnil, |
| 5811 | doc: /* *Width of this buffer's right fringe (in pixels). | 5783 | doc: /* *Width of this buffer's right fringe (in pixels). |
| 5812 | A value of 0 means no right fringe is shown in this buffer's window. | 5784 | A value of 0 means no right fringe is shown in this buffer's window. |
| 5813 | A value of nil means to use the right fringe width from the window's frame. */); | 5785 | A value of nil means to use the right fringe width from the window's frame. */); |
| 5814 | 5786 | ||
| 5815 | DEFVAR_PER_BUFFER ("fringes-outside-margins", &B_ (current_buffer, fringes_outside_margins), | 5787 | DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins), |
| 5816 | Qnil, | 5788 | Qnil, |
| 5817 | doc: /* *Non-nil means to display fringes outside display margins. | 5789 | doc: /* *Non-nil means to display fringes outside display margins. |
| 5818 | A value of nil means to display fringes between margins and buffer text. */); | 5790 | A value of nil means to display fringes between margins and buffer text. */); |
| 5819 | 5791 | ||
| 5820 | DEFVAR_PER_BUFFER ("scroll-bar-width", &B_ (current_buffer, scroll_bar_width), | 5792 | DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), |
| 5821 | Qnil, | 5793 | Qnil, |
| 5822 | doc: /* *Width of this buffer's scroll bars in pixels. | 5794 | doc: /* *Width of this buffer's scroll bars in pixels. |
| 5823 | A value of nil means to use the scroll bar width from the window's frame. */); | 5795 | A value of nil means to use the scroll bar width from the window's frame. */); |
| 5824 | 5796 | ||
| 5825 | DEFVAR_PER_BUFFER ("vertical-scroll-bar", &B_ (current_buffer, vertical_scroll_bar_type), | 5797 | DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type), |
| 5826 | Qnil, | 5798 | Qnil, |
| 5827 | doc: /* *Position of this buffer's vertical scroll bar. | 5799 | doc: /* *Position of this buffer's vertical scroll bar. |
| 5828 | The value takes effect whenever you tell a window to display this buffer; | 5800 | The value takes effect whenever you tell a window to display this buffer; |
| @@ -5833,13 +5805,13 @@ of the window; a value of nil means don't show any vertical scroll bars. | |||
| 5833 | A value of t (the default) means do whatever the window's frame specifies. */); | 5805 | A value of t (the default) means do whatever the window's frame specifies. */); |
| 5834 | 5806 | ||
| 5835 | DEFVAR_PER_BUFFER ("indicate-empty-lines", | 5807 | DEFVAR_PER_BUFFER ("indicate-empty-lines", |
| 5836 | &B_ (current_buffer, indicate_empty_lines), Qnil, | 5808 | &BVAR (current_buffer, indicate_empty_lines), Qnil, |
| 5837 | doc: /* *Visually indicate empty lines after the buffer end. | 5809 | doc: /* *Visually indicate empty lines after the buffer end. |
| 5838 | If non-nil, a bitmap is displayed in the left fringe of a window on | 5810 | If non-nil, a bitmap is displayed in the left fringe of a window on |
| 5839 | window-systems. */); | 5811 | window-systems. */); |
| 5840 | 5812 | ||
| 5841 | DEFVAR_PER_BUFFER ("indicate-buffer-boundaries", | 5813 | DEFVAR_PER_BUFFER ("indicate-buffer-boundaries", |
| 5842 | &B_ (current_buffer, indicate_buffer_boundaries), Qnil, | 5814 | &BVAR (current_buffer, indicate_buffer_boundaries), Qnil, |
| 5843 | doc: /* *Visually indicate buffer boundaries and scrolling. | 5815 | doc: /* *Visually indicate buffer boundaries and scrolling. |
| 5844 | If non-nil, the first and last line of the buffer are marked in the fringe | 5816 | If non-nil, the first and last line of the buffer are marked in the fringe |
| 5845 | of a window on window-systems with angle bitmaps, or if the window can be | 5817 | of a window on window-systems with angle bitmaps, or if the window can be |
| @@ -5864,7 +5836,7 @@ bitmaps in right fringe. To show just the angle bitmaps in the left | |||
| 5864 | fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */); | 5836 | fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */); |
| 5865 | 5837 | ||
| 5866 | DEFVAR_PER_BUFFER ("fringe-indicator-alist", | 5838 | DEFVAR_PER_BUFFER ("fringe-indicator-alist", |
| 5867 | &B_ (current_buffer, fringe_indicator_alist), Qnil, | 5839 | &BVAR (current_buffer, fringe_indicator_alist), Qnil, |
| 5868 | doc: /* *Mapping from logical to physical fringe indicator bitmaps. | 5840 | doc: /* *Mapping from logical to physical fringe indicator bitmaps. |
| 5869 | The value is an alist where each element (INDICATOR . BITMAPS) | 5841 | The value is an alist where each element (INDICATOR . BITMAPS) |
| 5870 | specifies the fringe bitmaps used to display a specific logical | 5842 | specifies the fringe bitmaps used to display a specific logical |
| @@ -5883,7 +5855,7 @@ last (only) line has no final newline. BITMAPS may also be a single | |||
| 5883 | symbol which is used in both left and right fringes. */); | 5855 | symbol which is used in both left and right fringes. */); |
| 5884 | 5856 | ||
| 5885 | DEFVAR_PER_BUFFER ("fringe-cursor-alist", | 5857 | DEFVAR_PER_BUFFER ("fringe-cursor-alist", |
| 5886 | &B_ (current_buffer, fringe_cursor_alist), Qnil, | 5858 | &BVAR (current_buffer, fringe_cursor_alist), Qnil, |
| 5887 | doc: /* *Mapping from logical to physical fringe cursor bitmaps. | 5859 | doc: /* *Mapping from logical to physical fringe cursor bitmaps. |
| 5888 | The value is an alist where each element (CURSOR . BITMAP) | 5860 | The value is an alist where each element (CURSOR . BITMAP) |
| 5889 | specifies the fringe bitmaps used to display a specific logical | 5861 | specifies the fringe bitmaps used to display a specific logical |
| @@ -5898,7 +5870,7 @@ BITMAP is the corresponding fringe bitmap shown for the logical | |||
| 5898 | cursor type. */); | 5870 | cursor type. */); |
| 5899 | 5871 | ||
| 5900 | DEFVAR_PER_BUFFER ("scroll-up-aggressively", | 5872 | DEFVAR_PER_BUFFER ("scroll-up-aggressively", |
| 5901 | &B_ (current_buffer, scroll_up_aggressively), Qnil, | 5873 | &BVAR (current_buffer, scroll_up_aggressively), Qnil, |
| 5902 | doc: /* How far to scroll windows upward. | 5874 | doc: /* How far to scroll windows upward. |
| 5903 | If you move point off the bottom, the window scrolls automatically. | 5875 | If you move point off the bottom, the window scrolls automatically. |
| 5904 | This variable controls how far it scrolls. The value nil, the default, | 5876 | This variable controls how far it scrolls. The value nil, the default, |
| @@ -5911,7 +5883,7 @@ window scrolls by a full window height. Meaningful values are | |||
| 5911 | between 0.0 and 1.0, inclusive. */); | 5883 | between 0.0 and 1.0, inclusive. */); |
| 5912 | 5884 | ||
| 5913 | DEFVAR_PER_BUFFER ("scroll-down-aggressively", | 5885 | DEFVAR_PER_BUFFER ("scroll-down-aggressively", |
| 5914 | &B_ (current_buffer, scroll_down_aggressively), Qnil, | 5886 | &BVAR (current_buffer, scroll_down_aggressively), Qnil, |
| 5915 | doc: /* How far to scroll windows downward. | 5887 | doc: /* How far to scroll windows downward. |
| 5916 | If you move point off the top, the window scrolls automatically. | 5888 | If you move point off the top, the window scrolls automatically. |
| 5917 | This variable controls how far it scrolls. The value nil, the default, | 5889 | This variable controls how far it scrolls. The value nil, the default, |
| @@ -5966,7 +5938,7 @@ from happening repeatedly and making Emacs nonfunctional. */); | |||
| 5966 | The functions are run using the `run-hooks' function. */); | 5938 | The functions are run using the `run-hooks' function. */); |
| 5967 | Vfirst_change_hook = Qnil; | 5939 | Vfirst_change_hook = Qnil; |
| 5968 | 5940 | ||
| 5969 | DEFVAR_PER_BUFFER ("buffer-undo-list", &B_ (current_buffer, undo_list), Qnil, | 5941 | DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil, |
| 5970 | doc: /* List of undo entries in current buffer. | 5942 | doc: /* List of undo entries in current buffer. |
| 5971 | Recent changes come first; older changes follow newer. | 5943 | Recent changes come first; older changes follow newer. |
| 5972 | 5944 | ||
| @@ -6007,10 +5979,10 @@ the changes between two undo boundaries as a single step to be undone. | |||
| 6007 | 5979 | ||
| 6008 | If the value of the variable is t, undo information is not recorded. */); | 5980 | If the value of the variable is t, undo information is not recorded. */); |
| 6009 | 5981 | ||
| 6010 | DEFVAR_PER_BUFFER ("mark-active", &B_ (current_buffer, mark_active), Qnil, | 5982 | DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil, |
| 6011 | doc: /* Non-nil means the mark and region are currently active in this buffer. */); | 5983 | doc: /* Non-nil means the mark and region are currently active in this buffer. */); |
| 6012 | 5984 | ||
| 6013 | DEFVAR_PER_BUFFER ("cache-long-line-scans", &B_ (current_buffer, cache_long_line_scans), Qnil, | 5985 | DEFVAR_PER_BUFFER ("cache-long-line-scans", &BVAR (current_buffer, cache_long_line_scans), Qnil, |
| 6014 | doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly. | 5986 | doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly. |
| 6015 | 5987 | ||
| 6016 | Normally, the line-motion functions work by scanning the buffer for | 5988 | Normally, the line-motion functions work by scanning the buffer for |
| @@ -6038,23 +6010,23 @@ maintained internally by the Emacs primitives. Enabling or disabling | |||
| 6038 | the cache should not affect the behavior of any of the motion | 6010 | the cache should not affect the behavior of any of the motion |
| 6039 | functions; it should only affect their performance. */); | 6011 | functions; it should only affect their performance. */); |
| 6040 | 6012 | ||
| 6041 | DEFVAR_PER_BUFFER ("point-before-scroll", &B_ (current_buffer, point_before_scroll), Qnil, | 6013 | DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil, |
| 6042 | doc: /* Value of point before the last series of scroll operations, or nil. */); | 6014 | doc: /* Value of point before the last series of scroll operations, or nil. */); |
| 6043 | 6015 | ||
| 6044 | DEFVAR_PER_BUFFER ("buffer-file-format", &B_ (current_buffer, file_format), Qnil, | 6016 | DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil, |
| 6045 | doc: /* List of formats to use when saving this buffer. | 6017 | doc: /* List of formats to use when saving this buffer. |
| 6046 | Formats are defined by `format-alist'. This variable is | 6018 | Formats are defined by `format-alist'. This variable is |
| 6047 | set when a file is visited. */); | 6019 | set when a file is visited. */); |
| 6048 | 6020 | ||
| 6049 | DEFVAR_PER_BUFFER ("buffer-auto-save-file-format", | 6021 | DEFVAR_PER_BUFFER ("buffer-auto-save-file-format", |
| 6050 | &B_ (current_buffer, auto_save_file_format), Qnil, | 6022 | &BVAR (current_buffer, auto_save_file_format), Qnil, |
| 6051 | doc: /* *Format in which to write auto-save files. | 6023 | doc: /* *Format in which to write auto-save files. |
| 6052 | Should be a list of symbols naming formats that are defined in `format-alist'. | 6024 | Should be a list of symbols naming formats that are defined in `format-alist'. |
| 6053 | If it is t, which is the default, auto-save files are written in the | 6025 | If it is t, which is the default, auto-save files are written in the |
| 6054 | same format as a regular save would use. */); | 6026 | same format as a regular save would use. */); |
| 6055 | 6027 | ||
| 6056 | DEFVAR_PER_BUFFER ("buffer-invisibility-spec", | 6028 | DEFVAR_PER_BUFFER ("buffer-invisibility-spec", |
| 6057 | &B_ (current_buffer, invisibility_spec), Qnil, | 6029 | &BVAR (current_buffer, invisibility_spec), Qnil, |
| 6058 | doc: /* Invisibility spec of this buffer. | 6030 | doc: /* Invisibility spec of this buffer. |
| 6059 | The default is t, which means that text is invisible | 6031 | The default is t, which means that text is invisible |
| 6060 | if it has a non-nil `invisible' property. | 6032 | if it has a non-nil `invisible' property. |
| @@ -6065,12 +6037,12 @@ then characters with property value PROP are invisible, | |||
| 6065 | and they have an ellipsis as well if ELLIPSIS is non-nil. */); | 6037 | and they have an ellipsis as well if ELLIPSIS is non-nil. */); |
| 6066 | 6038 | ||
| 6067 | DEFVAR_PER_BUFFER ("buffer-display-count", | 6039 | DEFVAR_PER_BUFFER ("buffer-display-count", |
| 6068 | &B_ (current_buffer, display_count), Qnil, | 6040 | &BVAR (current_buffer, display_count), Qnil, |
| 6069 | doc: /* A number incremented each time this buffer is displayed in a window. | 6041 | doc: /* A number incremented each time this buffer is displayed in a window. |
| 6070 | The function `set-window-buffer' increments it. */); | 6042 | The function `set-window-buffer' increments it. */); |
| 6071 | 6043 | ||
| 6072 | DEFVAR_PER_BUFFER ("buffer-display-time", | 6044 | DEFVAR_PER_BUFFER ("buffer-display-time", |
| 6073 | &B_ (current_buffer, display_time), Qnil, | 6045 | &BVAR (current_buffer, display_time), Qnil, |
| 6074 | doc: /* Time stamp updated each time this buffer is displayed in a window. | 6046 | doc: /* Time stamp updated each time this buffer is displayed in a window. |
| 6075 | The function `set-window-buffer' updates this variable | 6047 | The function `set-window-buffer' updates this variable |
| 6076 | to the value obtained by calling `current-time'. | 6048 | to the value obtained by calling `current-time'. |
| @@ -6105,7 +6077,7 @@ and disregard a `read-only' text property if the property value | |||
| 6105 | is a member of the list. */); | 6077 | is a member of the list. */); |
| 6106 | Vinhibit_read_only = Qnil; | 6078 | Vinhibit_read_only = Qnil; |
| 6107 | 6079 | ||
| 6108 | DEFVAR_PER_BUFFER ("cursor-type", &B_ (current_buffer, cursor_type), Qnil, | 6080 | DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil, |
| 6109 | doc: /* Cursor to use when this buffer is in the selected window. | 6081 | doc: /* Cursor to use when this buffer is in the selected window. |
| 6110 | Values are interpreted as follows: | 6082 | Values are interpreted as follows: |
| 6111 | 6083 | ||
| @@ -6124,7 +6096,7 @@ cursor's appearance is instead controlled by the variable | |||
| 6124 | `cursor-in-non-selected-windows'. */); | 6096 | `cursor-in-non-selected-windows'. */); |
| 6125 | 6097 | ||
| 6126 | DEFVAR_PER_BUFFER ("line-spacing", | 6098 | DEFVAR_PER_BUFFER ("line-spacing", |
| 6127 | &B_ (current_buffer, extra_line_spacing), Qnil, | 6099 | &BVAR (current_buffer, extra_line_spacing), Qnil, |
| 6128 | doc: /* Additional space to put between lines when displaying a buffer. | 6100 | doc: /* Additional space to put between lines when displaying a buffer. |
| 6129 | The space is measured in pixels, and put below lines on graphic displays, | 6101 | The space is measured in pixels, and put below lines on graphic displays, |
| 6130 | see `display-graphic-p'. | 6102 | see `display-graphic-p'. |
| @@ -6132,7 +6104,7 @@ If value is a floating point number, it specifies the spacing relative | |||
| 6132 | to the default frame line height. A value of nil means add no extra space. */); | 6104 | to the default frame line height. A value of nil means add no extra space. */); |
| 6133 | 6105 | ||
| 6134 | DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", | 6106 | DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", |
| 6135 | &B_ (current_buffer, cursor_in_non_selected_windows), Qnil, | 6107 | &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil, |
| 6136 | doc: /* *Non-nil means show a cursor in non-selected windows. | 6108 | doc: /* *Non-nil means show a cursor in non-selected windows. |
| 6137 | If nil, only shows a cursor in the selected window. | 6109 | If nil, only shows a cursor in the selected window. |
| 6138 | If t, displays a cursor related to the usual cursor type | 6110 | If t, displays a cursor related to the usual cursor type |
diff --git a/src/buffer.h b/src/buffer.h index 36cb5fe9dda..65c7168d60a 100644 --- a/src/buffer.h +++ b/src/buffer.h | |||
| @@ -321,7 +321,7 @@ while (0) | |||
| 321 | /* Return character at byte position POS. */ | 321 | /* Return character at byte position POS. */ |
| 322 | 322 | ||
| 323 | #define FETCH_CHAR(pos) \ | 323 | #define FETCH_CHAR(pos) \ |
| 324 | (!NILP (B_ (current_buffer, enable_multibyte_characters)) \ | 324 | (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \ |
| 325 | ? FETCH_MULTIBYTE_CHAR ((pos)) \ | 325 | ? FETCH_MULTIBYTE_CHAR ((pos)) \ |
| 326 | : FETCH_BYTE ((pos))) | 326 | : FETCH_BYTE ((pos))) |
| 327 | 327 | ||
| @@ -346,7 +346,7 @@ extern unsigned char *_fetch_multibyte_char_p; | |||
| 346 | multibyte. */ | 346 | multibyte. */ |
| 347 | 347 | ||
| 348 | #define FETCH_CHAR_AS_MULTIBYTE(pos) \ | 348 | #define FETCH_CHAR_AS_MULTIBYTE(pos) \ |
| 349 | (!NILP (B_ (current_buffer, enable_multibyte_characters)) \ | 349 | (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \ |
| 350 | ? FETCH_MULTIBYTE_CHAR ((pos)) \ | 350 | ? FETCH_MULTIBYTE_CHAR ((pos)) \ |
| 351 | : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos)))) | 351 | : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos)))) |
| 352 | 352 | ||
| @@ -465,13 +465,13 @@ struct buffer_text | |||
| 465 | }; | 465 | }; |
| 466 | 466 | ||
| 467 | /* Lisp fields in struct buffer are hidden from most code and accessed | 467 | /* Lisp fields in struct buffer are hidden from most code and accessed |
| 468 | via the B_ macro, below. Only select pieces of code, like the GC, | 468 | via the BVAR macro, below. Only select pieces of code, like the GC, |
| 469 | are allowed to use BUFFER_INTERNAL_FIELD. */ | 469 | are allowed to use BUFFER_INTERNAL_FIELD. */ |
| 470 | #define BUFFER_INTERNAL_FIELD(field) field ## _ | 470 | #define BUFFER_INTERNAL_FIELD(field) field ## _ |
| 471 | 471 | ||
| 472 | /* Most code should use this macro to access Lisp fields in struct | 472 | /* Most code should use this macro to access Lisp fields in struct |
| 473 | buffer. */ | 473 | buffer. */ |
| 474 | #define B_(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field)) | 474 | #define BVAR(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field)) |
| 475 | 475 | ||
| 476 | /* This is the structure that the buffer Lisp object points to. */ | 476 | /* This is the structure that the buffer Lisp object points to. */ |
| 477 | 477 | ||
| @@ -662,12 +662,6 @@ struct buffer | |||
| 662 | Lisp_Object BUFFER_INTERNAL_FIELD (left_margin); | 662 | Lisp_Object BUFFER_INTERNAL_FIELD (left_margin); |
| 663 | /* Function to call when insert space past fill column. */ | 663 | /* Function to call when insert space past fill column. */ |
| 664 | Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function); | 664 | Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function); |
| 665 | /* nil: text, t: binary. | ||
| 666 | This value is meaningful only on certain operating systems. */ | ||
| 667 | /* Actually, we don't need this flag any more because end-of-line | ||
| 668 | is handled correctly according to the buffer-file-coding-system | ||
| 669 | of the buffer. Just keeping it for backward compatibility. */ | ||
| 670 | Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_type); | ||
| 671 | 665 | ||
| 672 | /* Case table for case-conversion in this buffer. | 666 | /* Case table for case-conversion in this buffer. |
| 673 | This char-table maps each char into its lower-case version. */ | 667 | This char-table maps each char into its lower-case version. */ |
diff --git a/src/bytecode.c b/src/bytecode.c index a470eca16a9..cf4a1fc225f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -229,6 +229,8 @@ Lisp_Object Qbytecode; | |||
| 229 | #define Bconstant 0300 | 229 | #define Bconstant 0300 |
| 230 | #define CONSTANTLIM 0100 | 230 | #define CONSTANTLIM 0100 |
| 231 | 231 | ||
| 232 | /* Whether to maintain a `top' and `bottom' field in the stack frame. */ | ||
| 233 | #define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK) | ||
| 232 | 234 | ||
| 233 | /* Structure describing a value stack used during byte-code execution | 235 | /* Structure describing a value stack used during byte-code execution |
| 234 | in Fbyte_code. */ | 236 | in Fbyte_code. */ |
| @@ -241,7 +243,9 @@ struct byte_stack | |||
| 241 | 243 | ||
| 242 | /* Top and bottom of stack. The bottom points to an area of memory | 244 | /* Top and bottom of stack. The bottom points to an area of memory |
| 243 | allocated with alloca in Fbyte_code. */ | 245 | allocated with alloca in Fbyte_code. */ |
| 246 | #if BYTE_MAINTAIN_TOP | ||
| 244 | Lisp_Object *top, *bottom; | 247 | Lisp_Object *top, *bottom; |
| 248 | #endif | ||
| 245 | 249 | ||
| 246 | /* The string containing the byte-code, and its current address. | 250 | /* The string containing the byte-code, and its current address. |
| 247 | Storing this here protects it from GC because mark_byte_stack | 251 | Storing this here protects it from GC because mark_byte_stack |
| @@ -268,6 +272,7 @@ struct byte_stack *byte_stack_list; | |||
| 268 | 272 | ||
| 269 | /* Mark objects on byte_stack_list. Called during GC. */ | 273 | /* Mark objects on byte_stack_list. Called during GC. */ |
| 270 | 274 | ||
| 275 | #if BYTE_MARK_STACK | ||
| 271 | void | 276 | void |
| 272 | mark_byte_stack (void) | 277 | mark_byte_stack (void) |
| 273 | { | 278 | { |
| @@ -292,7 +297,7 @@ mark_byte_stack (void) | |||
| 292 | mark_object (stack->constants); | 297 | mark_object (stack->constants); |
| 293 | } | 298 | } |
| 294 | } | 299 | } |
| 295 | 300 | #endif | |
| 296 | 301 | ||
| 297 | /* Unmark objects in the stacks on byte_stack_list. Relocate program | 302 | /* Unmark objects in the stacks on byte_stack_list. Relocate program |
| 298 | counters. Called when GC has completed. */ | 303 | counters. Called when GC has completed. */ |
| @@ -346,8 +351,13 @@ unmark_byte_stack (void) | |||
| 346 | /* Actions that must be performed before and after calling a function | 351 | /* Actions that must be performed before and after calling a function |
| 347 | that might GC. */ | 352 | that might GC. */ |
| 348 | 353 | ||
| 354 | #if !BYTE_MAINTAIN_TOP | ||
| 355 | #define BEFORE_POTENTIAL_GC() ((void)0) | ||
| 356 | #define AFTER_POTENTIAL_GC() ((void)0) | ||
| 357 | #else | ||
| 349 | #define BEFORE_POTENTIAL_GC() stack.top = top | 358 | #define BEFORE_POTENTIAL_GC() stack.top = top |
| 350 | #define AFTER_POTENTIAL_GC() stack.top = NULL | 359 | #define AFTER_POTENTIAL_GC() stack.top = NULL |
| 360 | #endif | ||
| 351 | 361 | ||
| 352 | /* Garbage collect if we have consed enough since the last time. | 362 | /* Garbage collect if we have consed enough since the last time. |
| 353 | We do this at every branch, to avoid loops that never GC. */ | 363 | We do this at every branch, to avoid loops that never GC. */ |
| @@ -447,10 +457,13 @@ If the third argument is incorrect, Emacs may crash. */) | |||
| 447 | stack.byte_string = bytestr; | 457 | stack.byte_string = bytestr; |
| 448 | stack.pc = stack.byte_string_start = SDATA (bytestr); | 458 | stack.pc = stack.byte_string_start = SDATA (bytestr); |
| 449 | stack.constants = vector; | 459 | stack.constants = vector; |
| 450 | stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth) | 460 | top = (Lisp_Object *) alloca (XFASTINT (maxdepth) |
| 451 | * sizeof (Lisp_Object)); | 461 | * sizeof (Lisp_Object)); |
| 452 | top = stack.bottom - 1; | 462 | #if BYTE_MAINTAIN_TOP |
| 463 | stack.bottom = top; | ||
| 453 | stack.top = NULL; | 464 | stack.top = NULL; |
| 465 | #endif | ||
| 466 | top -= 1; | ||
| 454 | stack.next = byte_stack_list; | 467 | stack.next = byte_stack_list; |
| 455 | byte_stack_list = &stack; | 468 | byte_stack_list = &stack; |
| 456 | 469 | ||
| @@ -1398,7 +1411,7 @@ If the third argument is incorrect, Emacs may crash. */) | |||
| 1398 | CHECK_CHARACTER (TOP); | 1411 | CHECK_CHARACTER (TOP); |
| 1399 | AFTER_POTENTIAL_GC (); | 1412 | AFTER_POTENTIAL_GC (); |
| 1400 | c = XFASTINT (TOP); | 1413 | c = XFASTINT (TOP); |
| 1401 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 1414 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1402 | MAKE_CHAR_MULTIBYTE (c); | 1415 | MAKE_CHAR_MULTIBYTE (c); |
| 1403 | XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]); | 1416 | XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]); |
| 1404 | } | 1417 | } |
diff --git a/src/callint.c b/src/callint.c index 154659490b8..21dd3cd4d9d 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -149,12 +149,12 @@ static void | |||
| 149 | check_mark (int for_region) | 149 | check_mark (int for_region) |
| 150 | { | 150 | { |
| 151 | Lisp_Object tem; | 151 | Lisp_Object tem; |
| 152 | tem = Fmarker_buffer (B_ (current_buffer, mark)); | 152 | tem = Fmarker_buffer (BVAR (current_buffer, mark)); |
| 153 | if (NILP (tem) || (XBUFFER (tem) != current_buffer)) | 153 | if (NILP (tem) || (XBUFFER (tem) != current_buffer)) |
| 154 | error (for_region ? "The mark is not set now, so there is no region" | 154 | error (for_region ? "The mark is not set now, so there is no region" |
| 155 | : "The mark is not set now"); | 155 | : "The mark is not set now"); |
| 156 | if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) | 156 | if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) |
| 157 | && NILP (B_ (current_buffer, mark_active))) | 157 | && NILP (BVAR (current_buffer, mark_active))) |
| 158 | xsignal0 (Qmark_inactive); | 158 | xsignal0 (Qmark_inactive); |
| 159 | } | 159 | } |
| 160 | 160 | ||
| @@ -280,7 +280,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 280 | save_this_command = Vthis_command; | 280 | save_this_command = Vthis_command; |
| 281 | save_this_original_command = Vthis_original_command; | 281 | save_this_original_command = Vthis_original_command; |
| 282 | save_real_this_command = real_this_command; | 282 | save_real_this_command = real_this_command; |
| 283 | save_last_command = current_kboard->Vlast_command; | 283 | save_last_command = KVAR (current_kboard, Vlast_command); |
| 284 | 284 | ||
| 285 | if (NILP (keys)) | 285 | if (NILP (keys)) |
| 286 | keys = this_command_keys, key_count = this_command_key_count; | 286 | keys = this_command_keys, key_count = this_command_key_count; |
| @@ -363,7 +363,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 363 | Vthis_command = save_this_command; | 363 | Vthis_command = save_this_command; |
| 364 | Vthis_original_command = save_this_original_command; | 364 | Vthis_original_command = save_this_original_command; |
| 365 | real_this_command= save_real_this_command; | 365 | real_this_command= save_real_this_command; |
| 366 | current_kboard->Vlast_command = save_last_command; | 366 | KVAR (current_kboard, Vlast_command) = save_last_command; |
| 367 | 367 | ||
| 368 | temporarily_switch_to_single_kboard (NULL); | 368 | temporarily_switch_to_single_kboard (NULL); |
| 369 | return unbind_to (speccount, apply1 (function, specs)); | 369 | return unbind_to (speccount, apply1 (function, specs)); |
| @@ -385,7 +385,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 385 | else if (*string == '*') | 385 | else if (*string == '*') |
| 386 | { | 386 | { |
| 387 | string++; | 387 | string++; |
| 388 | if (!NILP (B_ (current_buffer, read_only))) | 388 | if (!NILP (BVAR (current_buffer, read_only))) |
| 389 | { | 389 | { |
| 390 | if (!NILP (record_flag)) | 390 | if (!NILP (record_flag)) |
| 391 | { | 391 | { |
| @@ -543,7 +543,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 543 | 543 | ||
| 544 | case 'D': /* Directory name. */ | 544 | case 'D': /* Directory name. */ |
| 545 | args[i] = Fread_file_name (callint_message, Qnil, | 545 | args[i] = Fread_file_name (callint_message, Qnil, |
| 546 | B_ (current_buffer, directory), Qlambda, Qnil, | 546 | BVAR (current_buffer, directory), Qlambda, Qnil, |
| 547 | Qfile_directory_p); | 547 | Qfile_directory_p); |
| 548 | break; | 548 | break; |
| 549 | 549 | ||
| @@ -661,7 +661,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 661 | case 'm': /* Value of mark. Does not do I/O. */ | 661 | case 'm': /* Value of mark. Does not do I/O. */ |
| 662 | check_mark (0); | 662 | check_mark (0); |
| 663 | /* visargs[i] = Qnil; */ | 663 | /* visargs[i] = Qnil; */ |
| 664 | args[i] = B_ (current_buffer, mark); | 664 | args[i] = BVAR (current_buffer, mark); |
| 665 | varies[i] = 2; | 665 | varies[i] = 2; |
| 666 | break; | 666 | break; |
| 667 | 667 | ||
| @@ -717,11 +717,11 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 717 | check_mark (1); | 717 | check_mark (1); |
| 718 | set_marker_both (point_marker, Qnil, PT, PT_BYTE); | 718 | set_marker_both (point_marker, Qnil, PT, PT_BYTE); |
| 719 | /* visargs[i+1] = Qnil; */ | 719 | /* visargs[i+1] = Qnil; */ |
| 720 | foo = marker_position (B_ (current_buffer, mark)); | 720 | foo = marker_position (BVAR (current_buffer, mark)); |
| 721 | /* visargs[i] = Qnil; */ | 721 | /* visargs[i] = Qnil; */ |
| 722 | args[i] = PT < foo ? point_marker : B_ (current_buffer, mark); | 722 | args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark); |
| 723 | varies[i] = 3; | 723 | varies[i] = 3; |
| 724 | args[++i] = PT > foo ? point_marker : B_ (current_buffer, mark); | 724 | args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark); |
| 725 | varies[i] = 4; | 725 | varies[i] = 4; |
| 726 | break; | 726 | break; |
| 727 | 727 | ||
| @@ -832,7 +832,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 832 | Vthis_command = save_this_command; | 832 | Vthis_command = save_this_command; |
| 833 | Vthis_original_command = save_this_original_command; | 833 | Vthis_original_command = save_this_original_command; |
| 834 | real_this_command= save_real_this_command; | 834 | real_this_command= save_real_this_command; |
| 835 | current_kboard->Vlast_command = save_last_command; | 835 | KVAR (current_kboard, Vlast_command) = save_last_command; |
| 836 | 836 | ||
| 837 | { | 837 | { |
| 838 | Lisp_Object val; | 838 | Lisp_Object val; |
diff --git a/src/callproc.c b/src/callproc.c index bdd3060bef1..c53a92bbaf8 100644 --- a/src/callproc.c +++ b/src/callproc.c | |||
| @@ -74,10 +74,6 @@ extern char **environ; | |||
| 74 | /* Pattern used by call-process-region to make temp files. */ | 74 | /* Pattern used by call-process-region to make temp files. */ |
| 75 | static Lisp_Object Vtemp_file_name_pattern; | 75 | static Lisp_Object Vtemp_file_name_pattern; |
| 76 | 76 | ||
| 77 | #ifdef DOS_NT | ||
| 78 | Lisp_Object Qbuffer_file_type; | ||
| 79 | #endif /* DOS_NT */ | ||
| 80 | |||
| 81 | /* True if we are about to fork off a synchronous process or if we | 77 | /* True if we are about to fork off a synchronous process or if we |
| 82 | are waiting for it. */ | 78 | are waiting for it. */ |
| 83 | int synch_process_alive; | 79 | int synch_process_alive; |
| @@ -265,7 +261,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) | |||
| 265 | 261 | ||
| 266 | if (nargs >= 2 && ! NILP (args[1])) | 262 | if (nargs >= 2 && ! NILP (args[1])) |
| 267 | { | 263 | { |
| 268 | infile = Fexpand_file_name (args[1], B_ (current_buffer, directory)); | 264 | infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory)); |
| 269 | CHECK_STRING (infile); | 265 | CHECK_STRING (infile); |
| 270 | } | 266 | } |
| 271 | else | 267 | else |
| @@ -322,7 +318,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) | |||
| 322 | { | 318 | { |
| 323 | struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | 319 | struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
| 324 | 320 | ||
| 325 | current_dir = B_ (current_buffer, directory); | 321 | current_dir = BVAR (current_buffer, directory); |
| 326 | 322 | ||
| 327 | GCPRO4 (infile, buffer, current_dir, error_file); | 323 | GCPRO4 (infile, buffer, current_dir, error_file); |
| 328 | 324 | ||
| @@ -336,7 +332,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) | |||
| 336 | 332 | ||
| 337 | if (NILP (Ffile_accessible_directory_p (current_dir))) | 333 | if (NILP (Ffile_accessible_directory_p (current_dir))) |
| 338 | report_file_error ("Setting current directory", | 334 | report_file_error ("Setting current directory", |
| 339 | Fcons (B_ (current_buffer, directory), Qnil)); | 335 | Fcons (BVAR (current_buffer, directory), Qnil)); |
| 340 | 336 | ||
| 341 | if (STRING_MULTIBYTE (infile)) | 337 | if (STRING_MULTIBYTE (infile)) |
| 342 | infile = ENCODE_FILE (infile); | 338 | infile = ENCODE_FILE (infile); |
| @@ -663,7 +659,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) | |||
| 663 | /* In unibyte mode, character code conversion should not take | 659 | /* In unibyte mode, character code conversion should not take |
| 664 | place but EOL conversion should. So, setup raw-text or one | 660 | place but EOL conversion should. So, setup raw-text or one |
| 665 | of the subsidiary according to the information just setup. */ | 661 | of the subsidiary according to the information just setup. */ |
| 666 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 662 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 667 | && !NILP (val)) | 663 | && !NILP (val)) |
| 668 | val = raw_text_coding_system (val); | 664 | val = raw_text_coding_system (val); |
| 669 | setup_coding_system (val, &process_coding); | 665 | setup_coding_system (val, &process_coding); |
| @@ -713,7 +709,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) | |||
| 713 | 709 | ||
| 714 | if (!NILP (buffer)) | 710 | if (!NILP (buffer)) |
| 715 | { | 711 | { |
| 716 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 712 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 717 | && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) | 713 | && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) |
| 718 | insert_1_both (buf, nread, nread, 0, 1, 0); | 714 | insert_1_both (buf, nread, nread, 0, 1, 0); |
| 719 | else | 715 | else |
| @@ -926,7 +922,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r | |||
| 926 | /* Decide coding-system of the contents of the temporary file. */ | 922 | /* Decide coding-system of the contents of the temporary file. */ |
| 927 | if (!NILP (Vcoding_system_for_write)) | 923 | if (!NILP (Vcoding_system_for_write)) |
| 928 | val = Vcoding_system_for_write; | 924 | val = Vcoding_system_for_write; |
| 929 | else if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 925 | else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 930 | val = Qraw_text; | 926 | val = Qraw_text; |
| 931 | else | 927 | else |
| 932 | { | 928 | { |
| @@ -1535,11 +1531,6 @@ set_initial_environment (void) | |||
| 1535 | void | 1531 | void |
| 1536 | syms_of_callproc (void) | 1532 | syms_of_callproc (void) |
| 1537 | { | 1533 | { |
| 1538 | #ifdef DOS_NT | ||
| 1539 | Qbuffer_file_type = intern_c_string ("buffer-file-type"); | ||
| 1540 | staticpro (&Qbuffer_file_type); | ||
| 1541 | #endif /* DOS_NT */ | ||
| 1542 | |||
| 1543 | #ifndef DOS_NT | 1534 | #ifndef DOS_NT |
| 1544 | Vtemp_file_name_pattern = build_string ("emacsXXXXXX"); | 1535 | Vtemp_file_name_pattern = build_string ("emacsXXXXXX"); |
| 1545 | #elif defined (WINDOWSNT) | 1536 | #elif defined (WINDOWSNT) |
diff --git a/src/casefiddle.c b/src/casefiddle.c index 6c05aecffe8..26fa0db2d77 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c | |||
| @@ -39,15 +39,15 @@ casify_object (enum case_action flag, Lisp_Object obj) | |||
| 39 | register int inword = flag == CASE_DOWN; | 39 | register int inword = flag == CASE_DOWN; |
| 40 | 40 | ||
| 41 | /* If the case table is flagged as modified, rescan it. */ | 41 | /* If the case table is flagged as modified, rescan it. */ |
| 42 | if (NILP (XCHAR_TABLE (B_ (current_buffer, downcase_table))->extras[1])) | 42 | if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) |
| 43 | Fset_case_table (B_ (current_buffer, downcase_table)); | 43 | Fset_case_table (BVAR (current_buffer, downcase_table)); |
| 44 | 44 | ||
| 45 | if (INTEGERP (obj)) | 45 | if (INTEGERP (obj)) |
| 46 | { | 46 | { |
| 47 | int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | 47 | int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER |
| 48 | | CHAR_SHIFT | CHAR_CTL | CHAR_META); | 48 | | CHAR_SHIFT | CHAR_CTL | CHAR_META); |
| 49 | int flags = XINT (obj) & flagbits; | 49 | int flags = XINT (obj) & flagbits; |
| 50 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 50 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 51 | 51 | ||
| 52 | /* If the character has higher bits set | 52 | /* If the character has higher bits set |
| 53 | above the flags, return it unchanged. | 53 | above the flags, return it unchanged. |
| @@ -198,7 +198,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) | |||
| 198 | { | 198 | { |
| 199 | register int c; | 199 | register int c; |
| 200 | register int inword = flag == CASE_DOWN; | 200 | register int inword = flag == CASE_DOWN; |
| 201 | register int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 201 | register int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 202 | EMACS_INT start, end; | 202 | EMACS_INT start, end; |
| 203 | EMACS_INT start_byte, end_byte; | 203 | EMACS_INT start_byte, end_byte; |
| 204 | EMACS_INT first = -1, last; /* Position of first and last changes. */ | 204 | 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) | |||
| 210 | return; | 210 | return; |
| 211 | 211 | ||
| 212 | /* If the case table is flagged as modified, rescan it. */ | 212 | /* If the case table is flagged as modified, rescan it. */ |
| 213 | if (NILP (XCHAR_TABLE (B_ (current_buffer, downcase_table))->extras[1])) | 213 | if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) |
| 214 | Fset_case_table (B_ (current_buffer, downcase_table)); | 214 | Fset_case_table (BVAR (current_buffer, downcase_table)); |
| 215 | 215 | ||
| 216 | validate_region (&b, &e); | 216 | validate_region (&b, &e); |
| 217 | start = XFASTINT (b); | 217 | start = XFASTINT (b); |
diff --git a/src/casetab.c b/src/casetab.c index 85c2d6e1581..5207e5315ae 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, | |||
| 71 | doc: /* Return the case table of the current buffer. */) | 71 | doc: /* Return the case table of the current buffer. */) |
| 72 | (void) | 72 | (void) |
| 73 | { | 73 | { |
| 74 | return B_ (current_buffer, downcase_table); | 74 | return BVAR (current_buffer, downcase_table); |
| 75 | } | 75 | } |
| 76 | 76 | ||
| 77 | DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, | 77 | 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) | |||
| 160 | } | 160 | } |
| 161 | else | 161 | else |
| 162 | { | 162 | { |
| 163 | B_ (current_buffer, downcase_table) = table; | 163 | BVAR (current_buffer, downcase_table) = table; |
| 164 | B_ (current_buffer, upcase_table) = up; | 164 | BVAR (current_buffer, upcase_table) = up; |
| 165 | B_ (current_buffer, case_canon_table) = canon; | 165 | BVAR (current_buffer, case_canon_table) = canon; |
| 166 | B_ (current_buffer, case_eqv_table) = eqv; | 166 | BVAR (current_buffer, case_eqv_table) = eqv; |
| 167 | } | 167 | } |
| 168 | 168 | ||
| 169 | return table; | 169 | return table; |
diff --git a/src/category.c b/src/category.c index bf8269ffd75..bcd73d3a487 100644 --- a/src/category.c +++ b/src/category.c | |||
| @@ -190,7 +190,7 @@ Lisp_Object | |||
| 190 | check_category_table (Lisp_Object table) | 190 | check_category_table (Lisp_Object table) |
| 191 | { | 191 | { |
| 192 | if (NILP (table)) | 192 | if (NILP (table)) |
| 193 | return B_ (current_buffer, category_table); | 193 | return BVAR (current_buffer, category_table); |
| 194 | CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table); | 194 | CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table); |
| 195 | return table; | 195 | return table; |
| 196 | } | 196 | } |
| @@ -200,7 +200,7 @@ DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0, | |||
| 200 | This is the one specified by the current buffer. */) | 200 | This is the one specified by the current buffer. */) |
| 201 | (void) | 201 | (void) |
| 202 | { | 202 | { |
| 203 | return B_ (current_buffer, category_table); | 203 | return BVAR (current_buffer, category_table); |
| 204 | } | 204 | } |
| 205 | 205 | ||
| 206 | DEFUN ("standard-category-table", Fstandard_category_table, | 206 | DEFUN ("standard-category-table", Fstandard_category_table, |
| @@ -281,7 +281,7 @@ Return TABLE. */) | |||
| 281 | { | 281 | { |
| 282 | int idx; | 282 | int idx; |
| 283 | table = check_category_table (table); | 283 | table = check_category_table (table); |
| 284 | B_ (current_buffer, category_table) = table; | 284 | BVAR (current_buffer, category_table) = table; |
| 285 | /* Indicate that this buffer now has a specified category table. */ | 285 | /* Indicate that this buffer now has a specified category table. */ |
| 286 | idx = PER_BUFFER_VAR_IDX (category_table); | 286 | idx = PER_BUFFER_VAR_IDX (category_table); |
| 287 | SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); | 287 | SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); |
| @@ -292,7 +292,7 @@ Return TABLE. */) | |||
| 292 | Lisp_Object | 292 | Lisp_Object |
| 293 | char_category_set (int c) | 293 | char_category_set (int c) |
| 294 | { | 294 | { |
| 295 | return CHAR_TABLE_REF (B_ (current_buffer, category_table), c); | 295 | return CHAR_TABLE_REF (BVAR (current_buffer, category_table), c); |
| 296 | } | 296 | } |
| 297 | 297 | ||
| 298 | DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, | 298 | DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, |
diff --git a/src/category.h b/src/category.h index 16b31da0819..b279f3d9c59 100644 --- a/src/category.h +++ b/src/category.h | |||
| @@ -91,7 +91,7 @@ extern Lisp_Object _temp_category_set; | |||
| 91 | 91 | ||
| 92 | /* The standard category table is stored where it will automatically | 92 | /* The standard category table is stored where it will automatically |
| 93 | be used in all new buffers. */ | 93 | be used in all new buffers. */ |
| 94 | #define Vstandard_category_table B_ (&buffer_defaults, category_table) | 94 | #define Vstandard_category_table BVAR (&buffer_defaults, category_table) |
| 95 | 95 | ||
| 96 | /* Return the category set of character C in the current category table. */ | 96 | /* Return the category set of character C in the current category table. */ |
| 97 | #define CATEGORY_SET(c) char_category_set (c) | 97 | #define CATEGORY_SET(c) char_category_set (c) |
diff --git a/src/character.c b/src/character.c index e4ff3d7922c..f12c4f28d31 100644 --- a/src/character.c +++ b/src/character.c | |||
| @@ -521,7 +521,7 @@ chars_in_text (const unsigned char *ptr, EMACS_INT nbytes) | |||
| 521 | { | 521 | { |
| 522 | /* current_buffer is null at early stages of Emacs initialization. */ | 522 | /* current_buffer is null at early stages of Emacs initialization. */ |
| 523 | if (current_buffer == 0 | 523 | if (current_buffer == 0 |
| 524 | || NILP (B_ (current_buffer, enable_multibyte_characters))) | 524 | || NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 525 | return nbytes; | 525 | return nbytes; |
| 526 | 526 | ||
| 527 | return multibyte_chars_in_text (ptr, nbytes); | 527 | return multibyte_chars_in_text (ptr, nbytes); |
| @@ -987,7 +987,7 @@ character is not ASCII nor 8-bit character, an error is signalled. */) | |||
| 987 | pos = XFASTINT (position); | 987 | pos = XFASTINT (position); |
| 988 | p = CHAR_POS_ADDR (pos); | 988 | p = CHAR_POS_ADDR (pos); |
| 989 | } | 989 | } |
| 990 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 990 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 991 | return make_number (*p); | 991 | return make_number (*p); |
| 992 | } | 992 | } |
| 993 | else | 993 | else |
diff --git a/src/character.h b/src/character.h index f2d06102f62..fb29ced66b7 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/>. */ | |||
| 417 | do \ | 417 | do \ |
| 418 | { \ | 418 | { \ |
| 419 | CHARIDX++; \ | 419 | CHARIDX++; \ |
| 420 | if (!NILP (B_ (current_buffer, enable_multibyte_characters))) \ | 420 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) \ |
| 421 | { \ | 421 | { \ |
| 422 | unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ | 422 | unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ |
| 423 | int len; \ | 423 | int len; \ |
| @@ -484,7 +484,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 484 | do \ | 484 | do \ |
| 485 | { \ | 485 | { \ |
| 486 | (charpos)++; \ | 486 | (charpos)++; \ |
| 487 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) \ | 487 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ |
| 488 | (bytepos)++; \ | 488 | (bytepos)++; \ |
| 489 | else \ | 489 | else \ |
| 490 | INC_POS ((bytepos)); \ | 490 | INC_POS ((bytepos)); \ |
| @@ -498,7 +498,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 498 | do \ | 498 | do \ |
| 499 | { \ | 499 | { \ |
| 500 | (charpos)--; \ | 500 | (charpos)--; \ |
| 501 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) \ | 501 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ |
| 502 | (bytepos)--; \ | 502 | (bytepos)--; \ |
| 503 | else \ | 503 | else \ |
| 504 | DEC_POS ((bytepos)); \ | 504 | DEC_POS ((bytepos)); \ |
| @@ -561,11 +561,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 561 | #define ASCII_CHAR_WIDTH(c) \ | 561 | #define ASCII_CHAR_WIDTH(c) \ |
| 562 | (c < 0x20 \ | 562 | (c < 0x20 \ |
| 563 | ? (c == '\t' \ | 563 | ? (c == '\t' \ |
| 564 | ? XFASTINT (B_ (current_buffer, tab_width)) \ | 564 | ? XFASTINT (BVAR (current_buffer, tab_width)) \ |
| 565 | : (c == '\n' ? 0 : (NILP (B_ (current_buffer, ctl_arrow)) ? 4 : 2))) \ | 565 | : (c == '\n' ? 0 : (NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))) \ |
| 566 | : (c < 0x7f \ | 566 | : (c < 0x7f \ |
| 567 | ? 1 \ | 567 | ? 1 \ |
| 568 | : ((NILP (B_ (current_buffer, ctl_arrow)) ? 4 : 2)))) | 568 | : ((NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2)))) |
| 569 | 569 | ||
| 570 | /* Return the width of character C. The width is measured by how many | 570 | /* Return the width of character C. The width is measured by how many |
| 571 | columns C will occupy on the screen when displayed in the current | 571 | columns C will occupy on the screen when displayed in the current |
diff --git a/src/charset.c b/src/charset.c index 80e6a114197..3624e740acb 100644 --- a/src/charset.c +++ b/src/charset.c | |||
| @@ -1554,7 +1554,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) | |||
| 1554 | EMACS_INT from, from_byte, to, stop, stop_byte; | 1554 | EMACS_INT from, from_byte, to, stop, stop_byte; |
| 1555 | int i; | 1555 | int i; |
| 1556 | Lisp_Object val; | 1556 | Lisp_Object val; |
| 1557 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 1557 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 1558 | 1558 | ||
| 1559 | validate_region (&beg, &end); | 1559 | validate_region (&beg, &end); |
| 1560 | from = XFASTINT (beg); | 1560 | from = XFASTINT (beg); |
diff --git a/src/cmds.c b/src/cmds.c index e82ada6f03c..336bf1154f9 100644 --- a/src/cmds.c +++ b/src/cmds.c | |||
| @@ -277,7 +277,7 @@ After insertion, the value of `auto-fill-function' is called if the | |||
| 277 | int remove_boundary = 1; | 277 | int remove_boundary = 1; |
| 278 | CHECK_NATNUM (n); | 278 | CHECK_NATNUM (n); |
| 279 | 279 | ||
| 280 | if (!EQ (Vthis_command, current_kboard->Vlast_command)) | 280 | if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command))) |
| 281 | nonundocount = 0; | 281 | nonundocount = 0; |
| 282 | 282 | ||
| 283 | if (NILP (Vexecuting_kbd_macro) | 283 | if (NILP (Vexecuting_kbd_macro) |
| @@ -292,10 +292,10 @@ After insertion, the value of `auto-fill-function' is called if the | |||
| 292 | } | 292 | } |
| 293 | 293 | ||
| 294 | if (remove_boundary | 294 | if (remove_boundary |
| 295 | && CONSP (B_ (current_buffer, undo_list)) | 295 | && CONSP (BVAR (current_buffer, undo_list)) |
| 296 | && NILP (XCAR (B_ (current_buffer, undo_list)))) | 296 | && NILP (XCAR (BVAR (current_buffer, undo_list)))) |
| 297 | /* Remove the undo_boundary that was just pushed. */ | 297 | /* Remove the undo_boundary that was just pushed. */ |
| 298 | B_ (current_buffer, undo_list) = XCDR (B_ (current_buffer, undo_list)); | 298 | BVAR (current_buffer, undo_list) = XCDR (BVAR (current_buffer, undo_list)); |
| 299 | 299 | ||
| 300 | /* Barf if the key that invoked this was not a character. */ | 300 | /* Barf if the key that invoked this was not a character. */ |
| 301 | if (!CHARACTERP (last_command_event)) | 301 | if (!CHARACTERP (last_command_event)) |
| @@ -335,12 +335,12 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 335 | EMACS_INT chars_to_delete = 0; | 335 | EMACS_INT chars_to_delete = 0; |
| 336 | EMACS_INT spaces_to_insert = 0; | 336 | EMACS_INT spaces_to_insert = 0; |
| 337 | 337 | ||
| 338 | overwrite = B_ (current_buffer, overwrite_mode); | 338 | overwrite = BVAR (current_buffer, overwrite_mode); |
| 339 | if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) | 339 | if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) |
| 340 | hairy = 1; | 340 | hairy = 1; |
| 341 | 341 | ||
| 342 | /* At first, get multi-byte form of C in STR. */ | 342 | /* At first, get multi-byte form of C in STR. */ |
| 343 | if (!NILP (B_ (current_buffer, enable_multibyte_characters))) | 343 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 344 | { | 344 | { |
| 345 | len = CHAR_STRING (c, str); | 345 | len = CHAR_STRING (c, str); |
| 346 | if (len == 1) | 346 | if (len == 1) |
| @@ -416,11 +416,11 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 416 | 416 | ||
| 417 | synt = SYNTAX (c); | 417 | synt = SYNTAX (c); |
| 418 | 418 | ||
| 419 | if (!NILP (B_ (current_buffer, abbrev_mode)) | 419 | if (!NILP (BVAR (current_buffer, abbrev_mode)) |
| 420 | && synt != Sword | 420 | && synt != Sword |
| 421 | && NILP (B_ (current_buffer, read_only)) | 421 | && NILP (BVAR (current_buffer, read_only)) |
| 422 | && PT > BEGV | 422 | && PT > BEGV |
| 423 | && (SYNTAX (!NILP (B_ (current_buffer, enable_multibyte_characters)) | 423 | && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 424 | ? XFASTINT (Fprevious_char ()) | 424 | ? XFASTINT (Fprevious_char ()) |
| 425 | : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) | 425 | : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) |
| 426 | == Sword)) | 426 | == Sword)) |
| @@ -448,7 +448,7 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 448 | 448 | ||
| 449 | if (chars_to_delete) | 449 | if (chars_to_delete) |
| 450 | { | 450 | { |
| 451 | int mc = ((NILP (B_ (current_buffer, enable_multibyte_characters)) | 451 | int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 452 | && SINGLE_BYTE_CHAR_P (c)) | 452 | && SINGLE_BYTE_CHAR_P (c)) |
| 453 | ? UNIBYTE_TO_CHAR (c) : c); | 453 | ? UNIBYTE_TO_CHAR (c) : c); |
| 454 | Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); | 454 | Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); |
| @@ -479,7 +479,7 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 479 | if ((CHAR_TABLE_P (Vauto_fill_chars) | 479 | if ((CHAR_TABLE_P (Vauto_fill_chars) |
| 480 | ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) | 480 | ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) |
| 481 | : (c == ' ' || c == '\n')) | 481 | : (c == ' ' || c == '\n')) |
| 482 | && !NILP (B_ (current_buffer, auto_fill_function))) | 482 | && !NILP (BVAR (current_buffer, auto_fill_function))) |
| 483 | { | 483 | { |
| 484 | Lisp_Object tem; | 484 | Lisp_Object tem; |
| 485 | 485 | ||
| @@ -488,7 +488,7 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 488 | that. Must have the newline in place already so filling and | 488 | that. Must have the newline in place already so filling and |
| 489 | justification, if any, know where the end is going to be. */ | 489 | justification, if any, know where the end is going to be. */ |
| 490 | SET_PT_BOTH (PT - 1, PT_BYTE - 1); | 490 | SET_PT_BOTH (PT - 1, PT_BYTE - 1); |
| 491 | tem = call0 (B_ (current_buffer, auto_fill_function)); | 491 | tem = call0 (BVAR (current_buffer, auto_fill_function)); |
| 492 | /* Test PT < ZV in case the auto-fill-function is strange. */ | 492 | /* Test PT < ZV in case the auto-fill-function is strange. */ |
| 493 | if (c == '\n' && PT < ZV) | 493 | if (c == '\n' && PT < ZV) |
| 494 | SET_PT_BOTH (PT + 1, PT_BYTE + 1); | 494 | SET_PT_BOTH (PT + 1, PT_BYTE + 1); |
diff --git a/src/coding.c b/src/coding.c index 899cca6d5aa..f6310369ad3 100644 --- a/src/coding.c +++ b/src/coding.c | |||
| @@ -7038,8 +7038,8 @@ decode_coding (struct coding_system *coding) | |||
| 7038 | set_buffer_internal (XBUFFER (coding->dst_object)); | 7038 | set_buffer_internal (XBUFFER (coding->dst_object)); |
| 7039 | if (GPT != PT) | 7039 | if (GPT != PT) |
| 7040 | move_gap_both (PT, PT_BYTE); | 7040 | move_gap_both (PT, PT_BYTE); |
| 7041 | undo_list = B_ (current_buffer, undo_list); | 7041 | undo_list = BVAR (current_buffer, undo_list); |
| 7042 | B_ (current_buffer, undo_list) = Qt; | 7042 | BVAR (current_buffer, undo_list) = Qt; |
| 7043 | } | 7043 | } |
| 7044 | 7044 | ||
| 7045 | coding->consumed = coding->consumed_char = 0; | 7045 | coding->consumed = coding->consumed_char = 0; |
| @@ -7136,7 +7136,7 @@ decode_coding (struct coding_system *coding) | |||
| 7136 | decode_eol (coding); | 7136 | decode_eol (coding); |
| 7137 | if (BUFFERP (coding->dst_object)) | 7137 | if (BUFFERP (coding->dst_object)) |
| 7138 | { | 7138 | { |
| 7139 | B_ (current_buffer, undo_list) = undo_list; | 7139 | BVAR (current_buffer, undo_list) = undo_list; |
| 7140 | record_insert (coding->dst_pos, coding->produced_char); | 7140 | record_insert (coding->dst_pos, coding->produced_char); |
| 7141 | } | 7141 | } |
| 7142 | return coding->result; | 7142 | return coding->result; |
| @@ -7433,7 +7433,7 @@ encode_coding (struct coding_system *coding) | |||
| 7433 | { | 7433 | { |
| 7434 | set_buffer_internal (XBUFFER (coding->dst_object)); | 7434 | set_buffer_internal (XBUFFER (coding->dst_object)); |
| 7435 | coding->dst_multibyte | 7435 | coding->dst_multibyte |
| 7436 | = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 7436 | = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 7437 | } | 7437 | } |
| 7438 | 7438 | ||
| 7439 | coding->consumed = coding->consumed_char = 0; | 7439 | coding->consumed = coding->consumed_char = 0; |
| @@ -7504,8 +7504,8 @@ make_conversion_work_buffer (int multibyte) | |||
| 7504 | doesn't compile new regexps. */ | 7504 | doesn't compile new regexps. */ |
| 7505 | Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); | 7505 | Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); |
| 7506 | Ferase_buffer (); | 7506 | Ferase_buffer (); |
| 7507 | B_ (current_buffer, undo_list) = Qt; | 7507 | BVAR (current_buffer, undo_list) = Qt; |
| 7508 | B_ (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil; | 7508 | BVAR (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil; |
| 7509 | set_buffer_internal (current); | 7509 | set_buffer_internal (current); |
| 7510 | return workbuf; | 7510 | return workbuf; |
| 7511 | } | 7511 | } |
| @@ -7562,7 +7562,7 @@ decode_coding_gap (struct coding_system *coding, | |||
| 7562 | coding->dst_object = coding->src_object; | 7562 | coding->dst_object = coding->src_object; |
| 7563 | coding->dst_pos = PT; | 7563 | coding->dst_pos = PT; |
| 7564 | coding->dst_pos_byte = PT_BYTE; | 7564 | coding->dst_pos_byte = PT_BYTE; |
| 7565 | coding->dst_multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 7565 | coding->dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 7566 | 7566 | ||
| 7567 | if (CODING_REQUIRE_DETECTION (coding)) | 7567 | if (CODING_REQUIRE_DETECTION (coding)) |
| 7568 | detect_coding (coding); | 7568 | detect_coding (coding); |
| @@ -7728,7 +7728,7 @@ decode_coding_object (struct coding_system *coding, | |||
| 7728 | coding->dst_pos = BUF_PT (XBUFFER (dst_object)); | 7728 | coding->dst_pos = BUF_PT (XBUFFER (dst_object)); |
| 7729 | coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object)); | 7729 | coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object)); |
| 7730 | coding->dst_multibyte | 7730 | coding->dst_multibyte |
| 7731 | = ! NILP (B_ (XBUFFER (dst_object), enable_multibyte_characters)); | 7731 | = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters)); |
| 7732 | } | 7732 | } |
| 7733 | else | 7733 | else |
| 7734 | { | 7734 | { |
| @@ -7798,7 +7798,7 @@ decode_coding_object (struct coding_system *coding, | |||
| 7798 | TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); | 7798 | TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); |
| 7799 | else if (saved_pt < from + chars) | 7799 | else if (saved_pt < from + chars) |
| 7800 | TEMP_SET_PT_BOTH (from, from_byte); | 7800 | TEMP_SET_PT_BOTH (from, from_byte); |
| 7801 | else if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 7801 | else if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 7802 | TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), | 7802 | TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), |
| 7803 | saved_pt_byte + (coding->produced - bytes)); | 7803 | saved_pt_byte + (coding->produced - bytes)); |
| 7804 | else | 7804 | else |
| @@ -7822,7 +7822,7 @@ decode_coding_object (struct coding_system *coding, | |||
| 7822 | { | 7822 | { |
| 7823 | tail->bytepos = from_byte + coding->produced; | 7823 | tail->bytepos = from_byte + coding->produced; |
| 7824 | tail->charpos | 7824 | tail->charpos |
| 7825 | = (NILP (B_ (current_buffer, enable_multibyte_characters)) | 7825 | = (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 7826 | ? tail->bytepos : from + coding->produced_char); | 7826 | ? tail->bytepos : from + coding->produced_char); |
| 7827 | } | 7827 | } |
| 7828 | } | 7828 | } |
| @@ -7960,7 +7960,7 @@ encode_coding_object (struct coding_system *coding, | |||
| 7960 | set_buffer_temp (current); | 7960 | set_buffer_temp (current); |
| 7961 | } | 7961 | } |
| 7962 | coding->dst_multibyte | 7962 | coding->dst_multibyte |
| 7963 | = ! NILP (B_ (XBUFFER (dst_object), enable_multibyte_characters)); | 7963 | = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters)); |
| 7964 | } | 7964 | } |
| 7965 | else if (EQ (dst_object, Qt)) | 7965 | else if (EQ (dst_object, Qt)) |
| 7966 | { | 7966 | { |
| @@ -8003,7 +8003,7 @@ encode_coding_object (struct coding_system *coding, | |||
| 8003 | TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); | 8003 | TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); |
| 8004 | else if (saved_pt < from + chars) | 8004 | else if (saved_pt < from + chars) |
| 8005 | TEMP_SET_PT_BOTH (from, from_byte); | 8005 | TEMP_SET_PT_BOTH (from, from_byte); |
| 8006 | else if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 8006 | else if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 8007 | TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), | 8007 | TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), |
| 8008 | saved_pt_byte + (coding->produced - bytes)); | 8008 | saved_pt_byte + (coding->produced - bytes)); |
| 8009 | else | 8009 | else |
| @@ -8027,7 +8027,7 @@ encode_coding_object (struct coding_system *coding, | |||
| 8027 | { | 8027 | { |
| 8028 | tail->bytepos = from_byte + coding->produced; | 8028 | tail->bytepos = from_byte + coding->produced; |
| 8029 | tail->charpos | 8029 | tail->charpos |
| 8030 | = (NILP (B_ (current_buffer, enable_multibyte_characters)) | 8030 | = (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 8031 | ? tail->bytepos : from + coding->produced_char); | 8031 | ? tail->bytepos : from + coding->produced_char); |
| 8032 | } | 8032 | } |
| 8033 | } | 8033 | } |
| @@ -8481,7 +8481,7 @@ highest priority. */) | |||
| 8481 | return detect_coding_system (BYTE_POS_ADDR (from_byte), | 8481 | return detect_coding_system (BYTE_POS_ADDR (from_byte), |
| 8482 | to - from, to_byte - from_byte, | 8482 | to - from, to_byte - from_byte, |
| 8483 | !NILP (highest), | 8483 | !NILP (highest), |
| 8484 | !NILP (B_ (current_buffer | 8484 | !NILP (BVAR (current_buffer |
| 8485 | , enable_multibyte_characters)), | 8485 | , enable_multibyte_characters)), |
| 8486 | Qnil); | 8486 | Qnil); |
| 8487 | } | 8487 | } |
| @@ -8564,7 +8564,7 @@ DEFUN ("find-coding-systems-region-internal", | |||
| 8564 | CHECK_NUMBER_COERCE_MARKER (end); | 8564 | CHECK_NUMBER_COERCE_MARKER (end); |
| 8565 | if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) | 8565 | if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) |
| 8566 | args_out_of_range (start, end); | 8566 | args_out_of_range (start, end); |
| 8567 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 8567 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 8568 | return Qt; | 8568 | return Qt; |
| 8569 | start_byte = CHAR_TO_BYTE (XINT (start)); | 8569 | start_byte = CHAR_TO_BYTE (XINT (start)); |
| 8570 | end_byte = CHAR_TO_BYTE (XINT (end)); | 8570 | end_byte = CHAR_TO_BYTE (XINT (end)); |
| @@ -8698,7 +8698,7 @@ to the string. */) | |||
| 8698 | validate_region (&start, &end); | 8698 | validate_region (&start, &end); |
| 8699 | from = XINT (start); | 8699 | from = XINT (start); |
| 8700 | to = XINT (end); | 8700 | to = XINT (end); |
| 8701 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 8701 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 8702 | || (ascii_compatible | 8702 | || (ascii_compatible |
| 8703 | && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from))))) | 8703 | && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from))))) |
| 8704 | return Qnil; | 8704 | return Qnil; |
| @@ -8814,7 +8814,7 @@ is nil. */) | |||
| 8814 | CHECK_NUMBER_COERCE_MARKER (end); | 8814 | CHECK_NUMBER_COERCE_MARKER (end); |
| 8815 | if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) | 8815 | if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) |
| 8816 | args_out_of_range (start, end); | 8816 | args_out_of_range (start, end); |
| 8817 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 8817 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 8818 | return Qnil; | 8818 | return Qnil; |
| 8819 | start_byte = CHAR_TO_BYTE (XINT (start)); | 8819 | start_byte = CHAR_TO_BYTE (XINT (start)); |
| 8820 | end_byte = CHAR_TO_BYTE (XINT (end)); | 8820 | end_byte = CHAR_TO_BYTE (XINT (end)); |
diff --git a/src/composite.c b/src/composite.c index 3c941ea6614..0b0602bf283 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 | |||
| 796 | 796 | ||
| 797 | if (NILP (string)) | 797 | if (NILP (string)) |
| 798 | { | 798 | { |
| 799 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 799 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 800 | error ("Attempt to shape unibyte text"); | 800 | error ("Attempt to shape unibyte text"); |
| 801 | validate_region (&start, &end); | 801 | validate_region (&start, &end); |
| 802 | from = XFASTINT (start); | 802 | from = XFASTINT (start); |
| @@ -1028,7 +1028,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, | |||
| 1028 | cmp_it->stop_pos = endpos = start; | 1028 | cmp_it->stop_pos = endpos = start; |
| 1029 | cmp_it->ch = -1; | 1029 | cmp_it->ch = -1; |
| 1030 | } | 1030 | } |
| 1031 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 1031 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 1032 | || NILP (Vauto_composition_mode)) | 1032 | || NILP (Vauto_composition_mode)) |
| 1033 | return; | 1033 | return; |
| 1034 | if (bytepos < 0) | 1034 | if (bytepos < 0) |
| @@ -1674,7 +1674,7 @@ composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt) | |||
| 1674 | return new_pt; | 1674 | return new_pt; |
| 1675 | } | 1675 | } |
| 1676 | 1676 | ||
| 1677 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 1677 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 1678 | || NILP (Vauto_composition_mode)) | 1678 | || NILP (Vauto_composition_mode)) |
| 1679 | return new_pt; | 1679 | return new_pt; |
| 1680 | 1680 | ||
| @@ -1851,7 +1851,7 @@ See `find-composition' for more details. */) | |||
| 1851 | 1851 | ||
| 1852 | if (!find_composition (from, to, &start, &end, &prop, string)) | 1852 | if (!find_composition (from, to, &start, &end, &prop, string)) |
| 1853 | { | 1853 | { |
| 1854 | if (!NILP (B_ (current_buffer, enable_multibyte_characters)) | 1854 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 1855 | && ! NILP (Vauto_composition_mode) | 1855 | && ! NILP (Vauto_composition_mode) |
| 1856 | && find_automatic_composition (from, to, &start, &end, &gstring, | 1856 | && find_automatic_composition (from, to, &start, &end, &gstring, |
| 1857 | string)) | 1857 | string)) |
diff --git a/src/data.c b/src/data.c index c0557d5c735..d0afca6a09f 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_ | |||
| 1009 | } | 1009 | } |
| 1010 | else | 1010 | else |
| 1011 | { | 1011 | { |
| 1012 | tem1 = assq_no_quit (var, B_ (current_buffer, local_var_alist)); | 1012 | tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); |
| 1013 | XSETBUFFER (blv->where, current_buffer); | 1013 | XSETBUFFER (blv->where, current_buffer); |
| 1014 | } | 1014 | } |
| 1015 | } | 1015 | } |
| @@ -1178,7 +1178,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register | |||
| 1178 | tem1 = Fassq (symbol, | 1178 | tem1 = Fassq (symbol, |
| 1179 | (blv->frame_local | 1179 | (blv->frame_local |
| 1180 | ? XFRAME (where)->param_alist | 1180 | ? XFRAME (where)->param_alist |
| 1181 | : B_ (XBUFFER (where), local_var_alist))); | 1181 | : BVAR (XBUFFER (where), local_var_alist))); |
| 1182 | blv->where = where; | 1182 | blv->where = where; |
| 1183 | blv->found = 1; | 1183 | blv->found = 1; |
| 1184 | 1184 | ||
| @@ -1209,8 +1209,8 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register | |||
| 1209 | bindings, not for frame-local bindings. */ | 1209 | bindings, not for frame-local bindings. */ |
| 1210 | eassert (!blv->frame_local); | 1210 | eassert (!blv->frame_local); |
| 1211 | tem1 = Fcons (symbol, XCDR (blv->defcell)); | 1211 | tem1 = Fcons (symbol, XCDR (blv->defcell)); |
| 1212 | B_ (XBUFFER (where), local_var_alist) | 1212 | BVAR (XBUFFER (where), local_var_alist) |
| 1213 | = Fcons (tem1, B_ (XBUFFER (where), local_var_alist)); | 1213 | = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); |
| 1214 | } | 1214 | } |
| 1215 | } | 1215 | } |
| 1216 | 1216 | ||
| @@ -1632,13 +1632,13 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) | |||
| 1632 | if (let_shadows_global_binding_p (symbol)) | 1632 | if (let_shadows_global_binding_p (symbol)) |
| 1633 | message ("Making %s local to %s while let-bound!", | 1633 | message ("Making %s local to %s while let-bound!", |
| 1634 | SDATA (SYMBOL_NAME (variable)), | 1634 | SDATA (SYMBOL_NAME (variable)), |
| 1635 | SDATA (B_ (current_buffer, name))); | 1635 | SDATA (BVAR (current_buffer, name))); |
| 1636 | } | 1636 | } |
| 1637 | } | 1637 | } |
| 1638 | 1638 | ||
| 1639 | /* Make sure this buffer has its own value of symbol. */ | 1639 | /* Make sure this buffer has its own value of symbol. */ |
| 1640 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ | 1640 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ |
| 1641 | tem = Fassq (variable, B_ (current_buffer, local_var_alist)); | 1641 | tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); |
| 1642 | if (NILP (tem)) | 1642 | if (NILP (tem)) |
| 1643 | { | 1643 | { |
| 1644 | if (let_shadows_buffer_binding_p (sym)) | 1644 | if (let_shadows_buffer_binding_p (sym)) |
| @@ -1650,9 +1650,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) | |||
| 1650 | default value. */ | 1650 | default value. */ |
| 1651 | find_symbol_value (variable); | 1651 | find_symbol_value (variable); |
| 1652 | 1652 | ||
| 1653 | B_ (current_buffer, local_var_alist) | 1653 | BVAR (current_buffer, local_var_alist) |
| 1654 | = Fcons (Fcons (variable, XCDR (blv->defcell)), | 1654 | = Fcons (Fcons (variable, XCDR (blv->defcell)), |
| 1655 | B_ (current_buffer, local_var_alist)); | 1655 | BVAR (current_buffer, local_var_alist)); |
| 1656 | 1656 | ||
| 1657 | /* Make sure symbol does not think it is set up for this buffer; | 1657 | /* Make sure symbol does not think it is set up for this buffer; |
| 1658 | force it to look once again for this buffer's value. */ | 1658 | 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. */) | |||
| 1718 | 1718 | ||
| 1719 | /* Get rid of this buffer's alist element, if any. */ | 1719 | /* Get rid of this buffer's alist element, if any. */ |
| 1720 | XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ | 1720 | XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ |
| 1721 | tem = Fassq (variable, B_ (current_buffer, local_var_alist)); | 1721 | tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); |
| 1722 | if (!NILP (tem)) | 1722 | if (!NILP (tem)) |
| 1723 | B_ (current_buffer, local_var_alist) | 1723 | BVAR (current_buffer, local_var_alist) |
| 1724 | = Fdelq (tem, B_ (current_buffer, local_var_alist)); | 1724 | = Fdelq (tem, BVAR (current_buffer, local_var_alist)); |
| 1725 | 1725 | ||
| 1726 | /* If the symbol is set up with the current buffer's binding | 1726 | /* If the symbol is set up with the current buffer's binding |
| 1727 | loaded, recompute its value. We have to do it now, or else | 1727 | loaded, recompute its value. We have to do it now, or else |
| @@ -1848,7 +1848,7 @@ BUFFER defaults to the current buffer. */) | |||
| 1848 | XSETBUFFER (tmp, buf); | 1848 | XSETBUFFER (tmp, buf); |
| 1849 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ | 1849 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ |
| 1850 | 1850 | ||
| 1851 | for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) | 1851 | for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) |
| 1852 | { | 1852 | { |
| 1853 | elt = XCAR (tail); | 1853 | elt = XCAR (tail); |
| 1854 | if (EQ (variable, XCAR (elt))) | 1854 | if (EQ (variable, XCAR (elt))) |
diff --git a/src/dired.c b/src/dired.c index f1dc03b56d0..7b4b83cbe54 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 | |||
| 158 | # ifdef WINDOWSNT | 158 | # ifdef WINDOWSNT |
| 159 | /* Windows users want case-insensitive wildcards. */ | 159 | /* Windows users want case-insensitive wildcards. */ |
| 160 | bufp = compile_pattern (match, 0, | 160 | bufp = compile_pattern (match, 0, |
| 161 | B_ (&buffer_defaults, case_canon_table), 0, 1); | 161 | BVAR (&buffer_defaults, case_canon_table), 0, 1); |
| 162 | # else /* !WINDOWSNT */ | 162 | # else /* !WINDOWSNT */ |
| 163 | bufp = compile_pattern (match, 0, Qnil, 0, 1); | 163 | bufp = compile_pattern (match, 0, Qnil, 0, 1); |
| 164 | # endif /* !WINDOWSNT */ | 164 | # endif /* !WINDOWSNT */ |
diff --git a/src/dispextern.h b/src/dispextern.h index e01c1a961f7..6bb0c3a6aae 100644 --- a/src/dispextern.h +++ b/src/dispextern.h | |||
| @@ -1416,7 +1416,7 @@ struct glyph_string | |||
| 1416 | && !(W)->pseudo_window_p \ | 1416 | && !(W)->pseudo_window_p \ |
| 1417 | && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ | 1417 | && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ |
| 1418 | && BUFFERP ((W)->buffer) \ | 1418 | && BUFFERP ((W)->buffer) \ |
| 1419 | && !NILP (B_ (XBUFFER ((W)->buffer), mode_line_format)) \ | 1419 | && !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format)) \ |
| 1420 | && WINDOW_TOTAL_LINES (W) > 1) | 1420 | && WINDOW_TOTAL_LINES (W) > 1) |
| 1421 | 1421 | ||
| 1422 | /* Value is non-zero if window W wants a header line. */ | 1422 | /* Value is non-zero if window W wants a header line. */ |
| @@ -1426,8 +1426,8 @@ struct glyph_string | |||
| 1426 | && !(W)->pseudo_window_p \ | 1426 | && !(W)->pseudo_window_p \ |
| 1427 | && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ | 1427 | && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ |
| 1428 | && BUFFERP ((W)->buffer) \ | 1428 | && BUFFERP ((W)->buffer) \ |
| 1429 | && !NILP (B_ (XBUFFER ((W)->buffer), header_line_format)) \ | 1429 | && !NILP (BVAR (XBUFFER ((W)->buffer), header_line_format)) \ |
| 1430 | && WINDOW_TOTAL_LINES (W) > 1 + !NILP (B_ (XBUFFER ((W)->buffer), mode_line_format))) | 1430 | && WINDOW_TOTAL_LINES (W) > 1 + !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format))) |
| 1431 | 1431 | ||
| 1432 | 1432 | ||
| 1433 | /* Return proper value to be used as baseline offset of font that has | 1433 | /* Return proper value to be used as baseline offset of font that has |
diff --git a/src/dispnew.c b/src/dispnew.c index 2aa3d9208b3..4e068bde536 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -6129,7 +6129,7 @@ pass nil for VARIABLE. */) | |||
| 6129 | { | 6129 | { |
| 6130 | buf = XCDR (XCAR (tail)); | 6130 | buf = XCDR (XCAR (tail)); |
| 6131 | /* Ignore buffers that aren't included in buffer lists. */ | 6131 | /* Ignore buffers that aren't included in buffer lists. */ |
| 6132 | if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') | 6132 | if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') |
| 6133 | continue; | 6133 | continue; |
| 6134 | if (vecp == end) | 6134 | if (vecp == end) |
| 6135 | goto changed; | 6135 | goto changed; |
| @@ -6137,7 +6137,7 @@ pass nil for VARIABLE. */) | |||
| 6137 | goto changed; | 6137 | goto changed; |
| 6138 | if (vecp == end) | 6138 | if (vecp == end) |
| 6139 | goto changed; | 6139 | goto changed; |
| 6140 | if (!EQ (*vecp++, B_ (XBUFFER (buf), read_only))) | 6140 | if (!EQ (*vecp++, BVAR (XBUFFER (buf), read_only))) |
| 6141 | goto changed; | 6141 | goto changed; |
| 6142 | if (vecp == end) | 6142 | if (vecp == end) |
| 6143 | goto changed; | 6143 | goto changed; |
| @@ -6184,10 +6184,10 @@ pass nil for VARIABLE. */) | |||
| 6184 | { | 6184 | { |
| 6185 | buf = XCDR (XCAR (tail)); | 6185 | buf = XCDR (XCAR (tail)); |
| 6186 | /* Ignore buffers that aren't included in buffer lists. */ | 6186 | /* Ignore buffers that aren't included in buffer lists. */ |
| 6187 | if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') | 6187 | if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') |
| 6188 | continue; | 6188 | continue; |
| 6189 | *vecp++ = buf; | 6189 | *vecp++ = buf; |
| 6190 | *vecp++ = B_ (XBUFFER (buf), read_only); | 6190 | *vecp++ = BVAR (XBUFFER (buf), read_only); |
| 6191 | *vecp++ = Fbuffer_modified_p (buf); | 6191 | *vecp++ = Fbuffer_modified_p (buf); |
| 6192 | } | 6192 | } |
| 6193 | /* Fill up the vector with lambdas (always at least one). */ | 6193 | /* Fill up the vector with lambdas (always at least one). */ |
| @@ -719,7 +719,7 @@ a new string, without any text properties, is returned. */) | |||
| 719 | or a specified local map (which means search just that and the | 719 | or a specified local map (which means search just that and the |
| 720 | global map). If non-nil, it might come from Voverriding_local_map, | 720 | global map). If non-nil, it might come from Voverriding_local_map, |
| 721 | or from a \\<mapname> construct in STRING itself.. */ | 721 | or from a \\<mapname> construct in STRING itself.. */ |
| 722 | keymap = current_kboard->Voverriding_terminal_local_map; | 722 | keymap = KVAR (current_kboard, Voverriding_terminal_local_map); |
| 723 | if (NILP (keymap)) | 723 | if (NILP (keymap)) |
| 724 | keymap = Voverriding_local_map; | 724 | keymap = Voverriding_local_map; |
| 725 | 725 | ||
diff --git a/src/editfns.c b/src/editfns.c index a3de4907efc..5d6189f2a3c 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -306,10 +306,10 @@ region_limit (int beginningp) | |||
| 306 | 306 | ||
| 307 | if (!NILP (Vtransient_mark_mode) | 307 | if (!NILP (Vtransient_mark_mode) |
| 308 | && NILP (Vmark_even_if_inactive) | 308 | && NILP (Vmark_even_if_inactive) |
| 309 | && NILP (B_ (current_buffer, mark_active))) | 309 | && NILP (BVAR (current_buffer, mark_active))) |
| 310 | xsignal0 (Qmark_inactive); | 310 | xsignal0 (Qmark_inactive); |
| 311 | 311 | ||
| 312 | m = Fmarker_position (B_ (current_buffer, mark)); | 312 | m = Fmarker_position (BVAR (current_buffer, mark)); |
| 313 | if (NILP (m)) | 313 | if (NILP (m)) |
| 314 | error ("The mark is not set now, so there is no region"); | 314 | error ("The mark is not set now, so there is no region"); |
| 315 | 315 | ||
| @@ -338,7 +338,7 @@ Watch out! Moving this marker changes the mark position. | |||
| 338 | If you set the marker not to point anywhere, the buffer will have no mark. */) | 338 | If you set the marker not to point anywhere, the buffer will have no mark. */) |
| 339 | (void) | 339 | (void) |
| 340 | { | 340 | { |
| 341 | return B_ (current_buffer, mark); | 341 | return BVAR (current_buffer, mark); |
| 342 | } | 342 | } |
| 343 | 343 | ||
| 344 | 344 | ||
| @@ -866,9 +866,9 @@ save_excursion_save (void) | |||
| 866 | == current_buffer); | 866 | == current_buffer); |
| 867 | 867 | ||
| 868 | return Fcons (Fpoint_marker (), | 868 | return Fcons (Fpoint_marker (), |
| 869 | Fcons (Fcopy_marker (B_ (current_buffer, mark), Qnil), | 869 | Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil), |
| 870 | Fcons (visible ? Qt : Qnil, | 870 | Fcons (visible ? Qt : Qnil, |
| 871 | Fcons (B_ (current_buffer, mark_active), | 871 | Fcons (BVAR (current_buffer, mark_active), |
| 872 | selected_window)))); | 872 | selected_window)))); |
| 873 | } | 873 | } |
| 874 | 874 | ||
| @@ -900,8 +900,8 @@ save_excursion_restore (Lisp_Object info) | |||
| 900 | /* Mark marker. */ | 900 | /* Mark marker. */ |
| 901 | info = XCDR (info); | 901 | info = XCDR (info); |
| 902 | tem = XCAR (info); | 902 | tem = XCAR (info); |
| 903 | omark = Fmarker_position (B_ (current_buffer, mark)); | 903 | omark = Fmarker_position (BVAR (current_buffer, mark)); |
| 904 | Fset_marker (B_ (current_buffer, mark), tem, Fcurrent_buffer ()); | 904 | Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ()); |
| 905 | nmark = Fmarker_position (tem); | 905 | nmark = Fmarker_position (tem); |
| 906 | unchain_marker (XMARKER (tem)); | 906 | unchain_marker (XMARKER (tem)); |
| 907 | 907 | ||
| @@ -922,14 +922,14 @@ save_excursion_restore (Lisp_Object info) | |||
| 922 | /* Mark active */ | 922 | /* Mark active */ |
| 923 | info = XCDR (info); | 923 | info = XCDR (info); |
| 924 | tem = XCAR (info); | 924 | tem = XCAR (info); |
| 925 | tem1 = B_ (current_buffer, mark_active); | 925 | tem1 = BVAR (current_buffer, mark_active); |
| 926 | B_ (current_buffer, mark_active) = tem; | 926 | BVAR (current_buffer, mark_active) = tem; |
| 927 | 927 | ||
| 928 | if (!NILP (Vrun_hooks)) | 928 | if (!NILP (Vrun_hooks)) |
| 929 | { | 929 | { |
| 930 | /* If mark is active now, and either was not active | 930 | /* If mark is active now, and either was not active |
| 931 | or was at a different place, run the activate hook. */ | 931 | or was at a different place, run the activate hook. */ |
| 932 | if (! NILP (B_ (current_buffer, mark_active))) | 932 | if (! NILP (BVAR (current_buffer, mark_active))) |
| 933 | { | 933 | { |
| 934 | if (! EQ (omark, nmark)) | 934 | if (! EQ (omark, nmark)) |
| 935 | call1 (Vrun_hooks, intern ("activate-mark-hook")); | 935 | call1 (Vrun_hooks, intern ("activate-mark-hook")); |
| @@ -1114,7 +1114,7 @@ At the beginning of the buffer or accessible region, return 0. */) | |||
| 1114 | Lisp_Object temp; | 1114 | Lisp_Object temp; |
| 1115 | if (PT <= BEGV) | 1115 | if (PT <= BEGV) |
| 1116 | XSETFASTINT (temp, 0); | 1116 | XSETFASTINT (temp, 0); |
| 1117 | else if (!NILP (B_ (current_buffer, enable_multibyte_characters))) | 1117 | else if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1118 | { | 1118 | { |
| 1119 | EMACS_INT pos = PT_BYTE; | 1119 | EMACS_INT pos = PT_BYTE; |
| 1120 | DEC_POS (pos); | 1120 | DEC_POS (pos); |
| @@ -1228,7 +1228,7 @@ If POS is out of range, the value is nil. */) | |||
| 1228 | pos_byte = CHAR_TO_BYTE (XINT (pos)); | 1228 | pos_byte = CHAR_TO_BYTE (XINT (pos)); |
| 1229 | } | 1229 | } |
| 1230 | 1230 | ||
| 1231 | if (!NILP (B_ (current_buffer, enable_multibyte_characters))) | 1231 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1232 | { | 1232 | { |
| 1233 | DEC_POS (pos_byte); | 1233 | DEC_POS (pos_byte); |
| 1234 | XSETFASTINT (val, FETCH_CHAR (pos_byte)); | 1234 | XSETFASTINT (val, FETCH_CHAR (pos_byte)); |
| @@ -2135,7 +2135,7 @@ general_insert_function (void (*insert_func) | |||
| 2135 | unsigned char str[MAX_MULTIBYTE_LENGTH]; | 2135 | unsigned char str[MAX_MULTIBYTE_LENGTH]; |
| 2136 | int len; | 2136 | int len; |
| 2137 | 2137 | ||
| 2138 | if (!NILP (B_ (current_buffer, enable_multibyte_characters))) | 2138 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2139 | len = CHAR_STRING (XFASTINT (val), str); | 2139 | len = CHAR_STRING (XFASTINT (val), str); |
| 2140 | else | 2140 | else |
| 2141 | { | 2141 | { |
| @@ -2267,7 +2267,7 @@ from adjoining text, if those properties are sticky. */) | |||
| 2267 | CHECK_NUMBER (character); | 2267 | CHECK_NUMBER (character); |
| 2268 | CHECK_NUMBER (count); | 2268 | CHECK_NUMBER (count); |
| 2269 | 2269 | ||
| 2270 | if (!NILP (B_ (current_buffer, enable_multibyte_characters))) | 2270 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2271 | len = CHAR_STRING (XFASTINT (character), str); | 2271 | len = CHAR_STRING (XFASTINT (character), str); |
| 2272 | else | 2272 | else |
| 2273 | str[0] = XFASTINT (character), len = 1; | 2273 | str[0] = XFASTINT (character), len = 1; |
| @@ -2316,7 +2316,7 @@ from adjoining text, if those properties are sticky. */) | |||
| 2316 | if (XINT (byte) < 0 || XINT (byte) > 255) | 2316 | if (XINT (byte) < 0 || XINT (byte) > 255) |
| 2317 | args_out_of_range_3 (byte, make_number (0), make_number (255)); | 2317 | args_out_of_range_3 (byte, make_number (0), make_number (255)); |
| 2318 | if (XINT (byte) >= 128 | 2318 | if (XINT (byte) >= 128 |
| 2319 | && ! NILP (B_ (current_buffer, enable_multibyte_characters))) | 2319 | && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2320 | XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); | 2320 | XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); |
| 2321 | return Finsert_char (byte, count, inherit); | 2321 | return Finsert_char (byte, count, inherit); |
| 2322 | } | 2322 | } |
| @@ -2370,7 +2370,7 @@ make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte, | |||
| 2370 | if (start < GPT && GPT < end) | 2370 | if (start < GPT && GPT < end) |
| 2371 | move_gap (start); | 2371 | move_gap (start); |
| 2372 | 2372 | ||
| 2373 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 2373 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2374 | result = make_uninit_multibyte_string (end - start, end_byte - start_byte); | 2374 | result = make_uninit_multibyte_string (end - start, end_byte - start_byte); |
| 2375 | else | 2375 | else |
| 2376 | result = make_uninit_string (end - start); | 2376 | result = make_uninit_string (end - start); |
| @@ -2485,7 +2485,7 @@ They default to the values of (point-min) and (point-max) in BUFFER. */) | |||
| 2485 | if (NILP (buf)) | 2485 | if (NILP (buf)) |
| 2486 | nsberror (buffer); | 2486 | nsberror (buffer); |
| 2487 | bp = XBUFFER (buf); | 2487 | bp = XBUFFER (buf); |
| 2488 | if (NILP (B_ (bp, name))) | 2488 | if (NILP (BVAR (bp, name))) |
| 2489 | error ("Selecting deleted buffer"); | 2489 | error ("Selecting deleted buffer"); |
| 2490 | 2490 | ||
| 2491 | if (NILP (start)) | 2491 | if (NILP (start)) |
| @@ -2533,8 +2533,8 @@ determines whether case is significant or ignored. */) | |||
| 2533 | register EMACS_INT begp1, endp1, begp2, endp2, temp; | 2533 | register EMACS_INT begp1, endp1, begp2, endp2, temp; |
| 2534 | register struct buffer *bp1, *bp2; | 2534 | register struct buffer *bp1, *bp2; |
| 2535 | register Lisp_Object trt | 2535 | register Lisp_Object trt |
| 2536 | = (!NILP (B_ (current_buffer, case_fold_search)) | 2536 | = (!NILP (BVAR (current_buffer, case_fold_search)) |
| 2537 | ? B_ (current_buffer, case_canon_table) : Qnil); | 2537 | ? BVAR (current_buffer, case_canon_table) : Qnil); |
| 2538 | EMACS_INT chars = 0; | 2538 | EMACS_INT chars = 0; |
| 2539 | EMACS_INT i1, i2, i1_byte, i2_byte; | 2539 | EMACS_INT i1, i2, i1_byte, i2_byte; |
| 2540 | 2540 | ||
| @@ -2549,7 +2549,7 @@ determines whether case is significant or ignored. */) | |||
| 2549 | if (NILP (buf1)) | 2549 | if (NILP (buf1)) |
| 2550 | nsberror (buffer1); | 2550 | nsberror (buffer1); |
| 2551 | bp1 = XBUFFER (buf1); | 2551 | bp1 = XBUFFER (buf1); |
| 2552 | if (NILP (B_ (bp1, name))) | 2552 | if (NILP (BVAR (bp1, name))) |
| 2553 | error ("Selecting deleted buffer"); | 2553 | error ("Selecting deleted buffer"); |
| 2554 | } | 2554 | } |
| 2555 | 2555 | ||
| @@ -2587,7 +2587,7 @@ determines whether case is significant or ignored. */) | |||
| 2587 | if (NILP (buf2)) | 2587 | if (NILP (buf2)) |
| 2588 | nsberror (buffer2); | 2588 | nsberror (buffer2); |
| 2589 | bp2 = XBUFFER (buf2); | 2589 | bp2 = XBUFFER (buf2); |
| 2590 | if (NILP (B_ (bp2, name))) | 2590 | if (NILP (BVAR (bp2, name))) |
| 2591 | error ("Selecting deleted buffer"); | 2591 | error ("Selecting deleted buffer"); |
| 2592 | } | 2592 | } |
| 2593 | 2593 | ||
| @@ -2627,7 +2627,7 @@ determines whether case is significant or ignored. */) | |||
| 2627 | 2627 | ||
| 2628 | QUIT; | 2628 | QUIT; |
| 2629 | 2629 | ||
| 2630 | if (! NILP (B_ (bp1, enable_multibyte_characters))) | 2630 | if (! NILP (BVAR (bp1, enable_multibyte_characters))) |
| 2631 | { | 2631 | { |
| 2632 | c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); | 2632 | c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); |
| 2633 | BUF_INC_POS (bp1, i1_byte); | 2633 | BUF_INC_POS (bp1, i1_byte); |
| @@ -2640,7 +2640,7 @@ determines whether case is significant or ignored. */) | |||
| 2640 | i1++; | 2640 | i1++; |
| 2641 | } | 2641 | } |
| 2642 | 2642 | ||
| 2643 | if (! NILP (B_ (bp2, enable_multibyte_characters))) | 2643 | if (! NILP (BVAR (bp2, enable_multibyte_characters))) |
| 2644 | { | 2644 | { |
| 2645 | c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte); | 2645 | c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte); |
| 2646 | BUF_INC_POS (bp2, i2_byte); | 2646 | BUF_INC_POS (bp2, i2_byte); |
| @@ -2680,13 +2680,13 @@ determines whether case is significant or ignored. */) | |||
| 2680 | static Lisp_Object | 2680 | static Lisp_Object |
| 2681 | subst_char_in_region_unwind (Lisp_Object arg) | 2681 | subst_char_in_region_unwind (Lisp_Object arg) |
| 2682 | { | 2682 | { |
| 2683 | return B_ (current_buffer, undo_list) = arg; | 2683 | return BVAR (current_buffer, undo_list) = arg; |
| 2684 | } | 2684 | } |
| 2685 | 2685 | ||
| 2686 | static Lisp_Object | 2686 | static Lisp_Object |
| 2687 | subst_char_in_region_unwind_1 (Lisp_Object arg) | 2687 | subst_char_in_region_unwind_1 (Lisp_Object arg) |
| 2688 | { | 2688 | { |
| 2689 | return B_ (current_buffer, filename) = arg; | 2689 | return BVAR (current_buffer, filename) = arg; |
| 2690 | } | 2690 | } |
| 2691 | 2691 | ||
| 2692 | DEFUN ("subst-char-in-region", Fsubst_char_in_region, | 2692 | DEFUN ("subst-char-in-region", Fsubst_char_in_region, |
| @@ -2712,7 +2712,7 @@ Both characters must have the same length of multi-byte form. */) | |||
| 2712 | #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) | 2712 | #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) |
| 2713 | int maybe_byte_combining = COMBINING_NO; | 2713 | int maybe_byte_combining = COMBINING_NO; |
| 2714 | EMACS_INT last_changed = 0; | 2714 | EMACS_INT last_changed = 0; |
| 2715 | int multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 2715 | int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 2716 | 2716 | ||
| 2717 | restart: | 2717 | restart: |
| 2718 | 2718 | ||
| @@ -2756,12 +2756,12 @@ Both characters must have the same length of multi-byte form. */) | |||
| 2756 | if (!changed && !NILP (noundo)) | 2756 | if (!changed && !NILP (noundo)) |
| 2757 | { | 2757 | { |
| 2758 | record_unwind_protect (subst_char_in_region_unwind, | 2758 | record_unwind_protect (subst_char_in_region_unwind, |
| 2759 | B_ (current_buffer, undo_list)); | 2759 | BVAR (current_buffer, undo_list)); |
| 2760 | B_ (current_buffer, undo_list) = Qt; | 2760 | BVAR (current_buffer, undo_list) = Qt; |
| 2761 | /* Don't do file-locking. */ | 2761 | /* Don't do file-locking. */ |
| 2762 | record_unwind_protect (subst_char_in_region_unwind_1, | 2762 | record_unwind_protect (subst_char_in_region_unwind_1, |
| 2763 | B_ (current_buffer, filename)); | 2763 | BVAR (current_buffer, filename)); |
| 2764 | B_ (current_buffer, filename) = Qnil; | 2764 | BVAR (current_buffer, filename) = Qnil; |
| 2765 | } | 2765 | } |
| 2766 | 2766 | ||
| 2767 | if (pos_byte < GPT_BYTE) | 2767 | if (pos_byte < GPT_BYTE) |
| @@ -2824,7 +2824,7 @@ Both characters must have the same length of multi-byte form. */) | |||
| 2824 | 2824 | ||
| 2825 | struct gcpro gcpro1; | 2825 | struct gcpro gcpro1; |
| 2826 | 2826 | ||
| 2827 | tem = B_ (current_buffer, undo_list); | 2827 | tem = BVAR (current_buffer, undo_list); |
| 2828 | GCPRO1 (tem); | 2828 | GCPRO1 (tem); |
| 2829 | 2829 | ||
| 2830 | /* Make a multibyte string containing this single character. */ | 2830 | /* Make a multibyte string containing this single character. */ |
| @@ -2843,7 +2843,7 @@ Both characters must have the same length of multi-byte form. */) | |||
| 2843 | INC_POS (pos_byte_next); | 2843 | INC_POS (pos_byte_next); |
| 2844 | 2844 | ||
| 2845 | if (! NILP (noundo)) | 2845 | if (! NILP (noundo)) |
| 2846 | B_ (current_buffer, undo_list) = tem; | 2846 | BVAR (current_buffer, undo_list) = tem; |
| 2847 | 2847 | ||
| 2848 | UNGCPRO; | 2848 | UNGCPRO; |
| 2849 | } | 2849 | } |
| @@ -2945,7 +2945,7 @@ It returns the number of characters changed. */) | |||
| 2945 | int cnt; /* Number of changes made. */ | 2945 | int cnt; /* Number of changes made. */ |
| 2946 | EMACS_INT size; /* Size of translate table. */ | 2946 | EMACS_INT size; /* Size of translate table. */ |
| 2947 | EMACS_INT pos, pos_byte, end_pos; | 2947 | EMACS_INT pos, pos_byte, end_pos; |
| 2948 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 2948 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 2949 | int string_multibyte; | 2949 | int string_multibyte; |
| 2950 | Lisp_Object val; | 2950 | Lisp_Object val; |
| 2951 | 2951 | ||
| @@ -3206,7 +3206,7 @@ save_restriction_restore (Lisp_Object data) | |||
| 3206 | ? XMARKER (XCAR (data))->buffer | 3206 | ? XMARKER (XCAR (data))->buffer |
| 3207 | : XBUFFER (data)); | 3207 | : XBUFFER (data)); |
| 3208 | 3208 | ||
| 3209 | if (buf && buf != current_buffer && !NILP (B_ (buf, pt_marker))) | 3209 | if (buf && buf != current_buffer && !NILP (BVAR (buf, pt_marker))) |
| 3210 | { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as | 3210 | { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as |
| 3211 | is the case if it is or has an indirect buffer), then make | 3211 | is the case if it is or has an indirect buffer), then make |
| 3212 | sure it is current before we update BEGV, so | 3212 | 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. */) | |||
| 4136 | 4136 | ||
| 4137 | if (XINT (c1) == XINT (c2)) | 4137 | if (XINT (c1) == XINT (c2)) |
| 4138 | return Qt; | 4138 | return Qt; |
| 4139 | if (NILP (B_ (current_buffer, case_fold_search))) | 4139 | if (NILP (BVAR (current_buffer, case_fold_search))) |
| 4140 | return Qnil; | 4140 | return Qnil; |
| 4141 | 4141 | ||
| 4142 | /* Do these in separate statements, | 4142 | /* Do these in separate statements, |
| 4143 | then compare the variables. | 4143 | then compare the variables. |
| 4144 | because of the way DOWNCASE uses temp variables. */ | 4144 | because of the way DOWNCASE uses temp variables. */ |
| 4145 | i1 = XFASTINT (c1); | 4145 | i1 = XFASTINT (c1); |
| 4146 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 4146 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 4147 | && ! ASCII_CHAR_P (i1)) | 4147 | && ! ASCII_CHAR_P (i1)) |
| 4148 | { | 4148 | { |
| 4149 | MAKE_CHAR_MULTIBYTE (i1); | 4149 | MAKE_CHAR_MULTIBYTE (i1); |
| 4150 | } | 4150 | } |
| 4151 | i2 = XFASTINT (c2); | 4151 | i2 = XFASTINT (c2); |
| 4152 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 4152 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 4153 | && ! ASCII_CHAR_P (i2)) | 4153 | && ! ASCII_CHAR_P (i2)) |
| 4154 | { | 4154 | { |
| 4155 | MAKE_CHAR_MULTIBYTE (i2); | 4155 | MAKE_CHAR_MULTIBYTE (i2); |
diff --git a/src/fileio.c b/src/fileio.c index 4a4935b43a2..2ccad83f668 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -770,7 +770,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) | |||
| 770 | 770 | ||
| 771 | /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ | 771 | /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ |
| 772 | if (NILP (default_directory)) | 772 | if (NILP (default_directory)) |
| 773 | default_directory = B_ (current_buffer, directory); | 773 | default_directory = BVAR (current_buffer, directory); |
| 774 | if (! STRINGP (default_directory)) | 774 | if (! STRINGP (default_directory)) |
| 775 | { | 775 | { |
| 776 | #ifdef DOS_NT | 776 | #ifdef DOS_NT |
| @@ -2669,7 +2669,7 @@ See `file-symlink-p' to distinguish symlinks. */) | |||
| 2669 | struct stat st; | 2669 | struct stat st; |
| 2670 | Lisp_Object handler; | 2670 | Lisp_Object handler; |
| 2671 | 2671 | ||
| 2672 | absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); | 2672 | absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); |
| 2673 | 2673 | ||
| 2674 | /* If the file name has special constructs in it, | 2674 | /* If the file name has special constructs in it, |
| 2675 | call the corresponding file handler. */ | 2675 | call the corresponding file handler. */ |
| @@ -2722,7 +2722,7 @@ See `file-symlink-p' to distinguish symlinks. */) | |||
| 2722 | struct stat st; | 2722 | struct stat st; |
| 2723 | Lisp_Object handler; | 2723 | Lisp_Object handler; |
| 2724 | 2724 | ||
| 2725 | absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); | 2725 | absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); |
| 2726 | 2726 | ||
| 2727 | /* If the file name has special constructs in it, | 2727 | /* If the file name has special constructs in it, |
| 2728 | call the corresponding file handler. */ | 2728 | call the corresponding file handler. */ |
| @@ -2769,7 +2769,7 @@ if file does not exist, is not accessible, or SELinux is disabled */) | |||
| 2769 | context_t context; | 2769 | context_t context; |
| 2770 | #endif | 2770 | #endif |
| 2771 | 2771 | ||
| 2772 | absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); | 2772 | absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); |
| 2773 | 2773 | ||
| 2774 | /* If the file name has special constructs in it, | 2774 | /* If the file name has special constructs in it, |
| 2775 | call the corresponding file handler. */ | 2775 | call the corresponding file handler. */ |
| @@ -2827,7 +2827,7 @@ is disabled. */) | |||
| 2827 | context_t parsed_con; | 2827 | context_t parsed_con; |
| 2828 | #endif | 2828 | #endif |
| 2829 | 2829 | ||
| 2830 | absname = Fexpand_file_name (filename, B_ (current_buffer, directory)); | 2830 | absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); |
| 2831 | 2831 | ||
| 2832 | /* If the file name has special constructs in it, | 2832 | /* If the file name has special constructs in it, |
| 2833 | call the corresponding file handler. */ | 2833 | call the corresponding file handler. */ |
| @@ -2894,7 +2894,7 @@ Return nil, if file does not exist or is not accessible. */) | |||
| 2894 | struct stat st; | 2894 | struct stat st; |
| 2895 | Lisp_Object handler; | 2895 | Lisp_Object handler; |
| 2896 | 2896 | ||
| 2897 | absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); | 2897 | absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); |
| 2898 | 2898 | ||
| 2899 | /* If the file name has special constructs in it, | 2899 | /* If the file name has special constructs in it, |
| 2900 | call the corresponding file handler. */ | 2900 | call the corresponding file handler. */ |
| @@ -2923,7 +2923,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */) | |||
| 2923 | Lisp_Object absname, encoded_absname; | 2923 | Lisp_Object absname, encoded_absname; |
| 2924 | Lisp_Object handler; | 2924 | Lisp_Object handler; |
| 2925 | 2925 | ||
| 2926 | absname = Fexpand_file_name (filename, B_ (current_buffer, directory)); | 2926 | absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); |
| 2927 | CHECK_NUMBER (mode); | 2927 | CHECK_NUMBER (mode); |
| 2928 | 2928 | ||
| 2929 | /* If the file name has special constructs in it, | 2929 | /* 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 | |||
| 2985 | if (! lisp_time_argument (time, &sec, &usec)) | 2985 | if (! lisp_time_argument (time, &sec, &usec)) |
| 2986 | error ("Invalid time specification"); | 2986 | error ("Invalid time specification"); |
| 2987 | 2987 | ||
| 2988 | absname = Fexpand_file_name (filename, B_ (current_buffer, directory)); | 2988 | absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); |
| 2989 | 2989 | ||
| 2990 | /* If the file name has special constructs in it, | 2990 | /* If the file name has special constructs in it, |
| 2991 | call the corresponding file handler. */ | 2991 | call the corresponding file handler. */ |
| @@ -3047,8 +3047,8 @@ otherwise, if FILE2 does not exist, the answer is t. */) | |||
| 3047 | 3047 | ||
| 3048 | absname1 = Qnil; | 3048 | absname1 = Qnil; |
| 3049 | GCPRO2 (absname1, file2); | 3049 | GCPRO2 (absname1, file2); |
| 3050 | absname1 = expand_and_dir_to_file (file1, B_ (current_buffer, directory)); | 3050 | absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory)); |
| 3051 | absname2 = expand_and_dir_to_file (file2, B_ (current_buffer, directory)); | 3051 | absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory)); |
| 3052 | UNGCPRO; | 3052 | UNGCPRO; |
| 3053 | 3053 | ||
| 3054 | /* If the file name has special constructs in it, | 3054 | /* If the file name has special constructs in it, |
| @@ -3075,10 +3075,6 @@ otherwise, if FILE2 does not exist, the answer is t. */) | |||
| 3075 | return (mtime1 > st.st_mtime) ? Qt : Qnil; | 3075 | return (mtime1 > st.st_mtime) ? Qt : Qnil; |
| 3076 | } | 3076 | } |
| 3077 | 3077 | ||
| 3078 | #ifdef DOS_NT | ||
| 3079 | Lisp_Object Qfind_buffer_file_type; | ||
| 3080 | #endif /* DOS_NT */ | ||
| 3081 | |||
| 3082 | #ifndef READ_BUF_SIZE | 3078 | #ifndef READ_BUF_SIZE |
| 3083 | #define READ_BUF_SIZE (64 << 10) | 3079 | #define READ_BUF_SIZE (64 << 10) |
| 3084 | #endif | 3080 | #endif |
| @@ -3116,8 +3112,8 @@ decide_coding_unwind (Lisp_Object unwind_data) | |||
| 3116 | TEMP_SET_PT_BOTH (BEG, BEG_BYTE); | 3112 | TEMP_SET_PT_BOTH (BEG, BEG_BYTE); |
| 3117 | 3113 | ||
| 3118 | /* Now we are safe to change the buffer's multibyteness directly. */ | 3114 | /* Now we are safe to change the buffer's multibyteness directly. */ |
| 3119 | B_ (current_buffer, enable_multibyte_characters) = multibyte; | 3115 | BVAR (current_buffer, enable_multibyte_characters) = multibyte; |
| 3120 | B_ (current_buffer, undo_list) = undo_list; | 3116 | BVAR (current_buffer, undo_list) = undo_list; |
| 3121 | 3117 | ||
| 3122 | return Qnil; | 3118 | return Qnil; |
| 3123 | } | 3119 | } |
| @@ -3212,7 +3208,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3212 | if (current_buffer->base_buffer && ! NILP (visit)) | 3208 | if (current_buffer->base_buffer && ! NILP (visit)) |
| 3213 | error ("Cannot do file visiting in an indirect buffer"); | 3209 | error ("Cannot do file visiting in an indirect buffer"); |
| 3214 | 3210 | ||
| 3215 | if (!NILP (B_ (current_buffer, read_only))) | 3211 | if (!NILP (BVAR (current_buffer, read_only))) |
| 3216 | Fbarf_if_buffer_read_only (); | 3212 | Fbarf_if_buffer_read_only (); |
| 3217 | 3213 | ||
| 3218 | val = Qnil; | 3214 | val = Qnil; |
| @@ -3403,16 +3399,16 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3403 | buf = XBUFFER (buffer); | 3399 | buf = XBUFFER (buffer); |
| 3404 | 3400 | ||
| 3405 | delete_all_overlays (buf); | 3401 | delete_all_overlays (buf); |
| 3406 | B_ (buf, directory) = B_ (current_buffer, directory); | 3402 | BVAR (buf, directory) = BVAR (current_buffer, directory); |
| 3407 | B_ (buf, read_only) = Qnil; | 3403 | BVAR (buf, read_only) = Qnil; |
| 3408 | B_ (buf, filename) = Qnil; | 3404 | BVAR (buf, filename) = Qnil; |
| 3409 | B_ (buf, undo_list) = Qt; | 3405 | BVAR (buf, undo_list) = Qt; |
| 3410 | eassert (buf->overlays_before == NULL); | 3406 | eassert (buf->overlays_before == NULL); |
| 3411 | eassert (buf->overlays_after == NULL); | 3407 | eassert (buf->overlays_after == NULL); |
| 3412 | 3408 | ||
| 3413 | set_buffer_internal (buf); | 3409 | set_buffer_internal (buf); |
| 3414 | Ferase_buffer (); | 3410 | Ferase_buffer (); |
| 3415 | B_ (buf, enable_multibyte_characters) = Qnil; | 3411 | BVAR (buf, enable_multibyte_characters) = Qnil; |
| 3416 | 3412 | ||
| 3417 | insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); | 3413 | insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); |
| 3418 | TEMP_SET_PT_BOTH (BEG, BEG_BYTE); | 3414 | TEMP_SET_PT_BOTH (BEG, BEG_BYTE); |
| @@ -3450,7 +3446,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3450 | else | 3446 | else |
| 3451 | CHECK_CODING_SYSTEM (coding_system); | 3447 | CHECK_CODING_SYSTEM (coding_system); |
| 3452 | 3448 | ||
| 3453 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 3449 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3454 | /* We must suppress all character code conversion except for | 3450 | /* We must suppress all character code conversion except for |
| 3455 | end-of-line conversion. */ | 3451 | end-of-line conversion. */ |
| 3456 | coding_system = raw_text_coding_system (coding_system); | 3452 | coding_system = raw_text_coding_system (coding_system); |
| @@ -3598,7 +3594,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3598 | we cannot use this method; giveup and try the other. */ | 3594 | we cannot use this method; giveup and try the other. */ |
| 3599 | if (same_at_end > same_at_start | 3595 | if (same_at_end > same_at_start |
| 3600 | && FETCH_BYTE (same_at_end - 1) >= 0200 | 3596 | && FETCH_BYTE (same_at_end - 1) >= 0200 |
| 3601 | && ! NILP (B_ (current_buffer, enable_multibyte_characters)) | 3597 | && ! NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 3602 | && (CODING_MAY_REQUIRE_DECODING (&coding))) | 3598 | && (CODING_MAY_REQUIRE_DECODING (&coding))) |
| 3603 | giveup_match_end = 1; | 3599 | giveup_match_end = 1; |
| 3604 | break; | 3600 | break; |
| @@ -3617,14 +3613,14 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3617 | 3613 | ||
| 3618 | /* Extend the start of non-matching text area to multibyte | 3614 | /* Extend the start of non-matching text area to multibyte |
| 3619 | character boundary. */ | 3615 | character boundary. */ |
| 3620 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 3616 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3621 | while (same_at_start > BEGV_BYTE | 3617 | while (same_at_start > BEGV_BYTE |
| 3622 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) | 3618 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) |
| 3623 | same_at_start--; | 3619 | same_at_start--; |
| 3624 | 3620 | ||
| 3625 | /* Extend the end of non-matching text area to multibyte | 3621 | /* Extend the end of non-matching text area to multibyte |
| 3626 | character boundary. */ | 3622 | character boundary. */ |
| 3627 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 3623 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3628 | while (same_at_end < ZV_BYTE | 3624 | while (same_at_end < ZV_BYTE |
| 3629 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) | 3625 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) |
| 3630 | same_at_end++; | 3626 | same_at_end++; |
| @@ -3673,7 +3669,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3673 | unsigned char *decoded; | 3669 | unsigned char *decoded; |
| 3674 | EMACS_INT temp; | 3670 | EMACS_INT temp; |
| 3675 | int this_count = SPECPDL_INDEX (); | 3671 | int this_count = SPECPDL_INDEX (); |
| 3676 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 3672 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 3677 | Lisp_Object conversion_buffer; | 3673 | Lisp_Object conversion_buffer; |
| 3678 | 3674 | ||
| 3679 | conversion_buffer = code_conversion_save (1, multibyte); | 3675 | conversion_buffer = code_conversion_save (1, multibyte); |
| @@ -3778,7 +3774,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3778 | 3774 | ||
| 3779 | /* Extend the start of non-matching text area to the previous | 3775 | /* Extend the start of non-matching text area to the previous |
| 3780 | multibyte character boundary. */ | 3776 | multibyte character boundary. */ |
| 3781 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 3777 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3782 | while (same_at_start > BEGV_BYTE | 3778 | while (same_at_start > BEGV_BYTE |
| 3783 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) | 3779 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) |
| 3784 | same_at_start--; | 3780 | same_at_start--; |
| @@ -3795,7 +3791,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3795 | 3791 | ||
| 3796 | /* Extend the end of non-matching text area to the next | 3792 | /* Extend the end of non-matching text area to the next |
| 3797 | multibyte character boundary. */ | 3793 | multibyte character boundary. */ |
| 3798 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 3794 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3799 | while (same_at_end < ZV_BYTE | 3795 | while (same_at_end < ZV_BYTE |
| 3800 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) | 3796 | && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) |
| 3801 | same_at_end++; | 3797 | same_at_end++; |
| @@ -3870,9 +3866,9 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3870 | if (NILP (visit) && inserted > 0) | 3866 | if (NILP (visit) && inserted > 0) |
| 3871 | { | 3867 | { |
| 3872 | #ifdef CLASH_DETECTION | 3868 | #ifdef CLASH_DETECTION |
| 3873 | if (!NILP (B_ (current_buffer, file_truename)) | 3869 | if (!NILP (BVAR (current_buffer, file_truename)) |
| 3874 | /* Make binding buffer-file-name to nil effective. */ | 3870 | /* Make binding buffer-file-name to nil effective. */ |
| 3875 | && !NILP (B_ (current_buffer, filename)) | 3871 | && !NILP (BVAR (current_buffer, filename)) |
| 3876 | && SAVE_MODIFF >= MODIFF) | 3872 | && SAVE_MODIFF >= MODIFF) |
| 3877 | we_locked_file = 1; | 3873 | we_locked_file = 1; |
| 3878 | #endif /* CLASH_DETECTION */ | 3874 | #endif /* CLASH_DETECTION */ |
| @@ -3977,7 +3973,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 3977 | { | 3973 | { |
| 3978 | #ifdef CLASH_DETECTION | 3974 | #ifdef CLASH_DETECTION |
| 3979 | if (we_locked_file) | 3975 | if (we_locked_file) |
| 3980 | unlock_file (B_ (current_buffer, file_truename)); | 3976 | unlock_file (BVAR (current_buffer, file_truename)); |
| 3981 | #endif | 3977 | #endif |
| 3982 | Vdeactivate_mark = old_Vdeactivate_mark; | 3978 | Vdeactivate_mark = old_Vdeactivate_mark; |
| 3983 | } | 3979 | } |
| @@ -4028,11 +4024,11 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4028 | Lisp_Object unwind_data; | 4024 | Lisp_Object unwind_data; |
| 4029 | int count = SPECPDL_INDEX (); | 4025 | int count = SPECPDL_INDEX (); |
| 4030 | 4026 | ||
| 4031 | unwind_data = Fcons (B_ (current_buffer, enable_multibyte_characters), | 4027 | unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters), |
| 4032 | Fcons (B_ (current_buffer, undo_list), | 4028 | Fcons (BVAR (current_buffer, undo_list), |
| 4033 | Fcurrent_buffer ())); | 4029 | Fcurrent_buffer ())); |
| 4034 | B_ (current_buffer, enable_multibyte_characters) = Qnil; | 4030 | BVAR (current_buffer, enable_multibyte_characters) = Qnil; |
| 4035 | B_ (current_buffer, undo_list) = Qt; | 4031 | BVAR (current_buffer, undo_list) = Qt; |
| 4036 | record_unwind_protect (decide_coding_unwind, unwind_data); | 4032 | record_unwind_protect (decide_coding_unwind, unwind_data); |
| 4037 | 4033 | ||
| 4038 | if (inserted > 0 && ! NILP (Vset_auto_coding_function)) | 4034 | if (inserted > 0 && ! NILP (Vset_auto_coding_function)) |
| @@ -4062,7 +4058,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4062 | else | 4058 | else |
| 4063 | CHECK_CODING_SYSTEM (coding_system); | 4059 | CHECK_CODING_SYSTEM (coding_system); |
| 4064 | 4060 | ||
| 4065 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 4061 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 4066 | /* We must suppress all character code conversion except for | 4062 | /* We must suppress all character code conversion except for |
| 4067 | end-of-line conversion. */ | 4063 | end-of-line conversion. */ |
| 4068 | coding_system = raw_text_coding_system (coding_system); | 4064 | coding_system = raw_text_coding_system (coding_system); |
| @@ -4080,10 +4076,10 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4080 | && NILP (replace)) | 4076 | && NILP (replace)) |
| 4081 | /* Visiting a file with these coding system makes the buffer | 4077 | /* Visiting a file with these coding system makes the buffer |
| 4082 | unibyte. */ | 4078 | unibyte. */ |
| 4083 | B_ (current_buffer, enable_multibyte_characters) = Qnil; | 4079 | BVAR (current_buffer, enable_multibyte_characters) = Qnil; |
| 4084 | } | 4080 | } |
| 4085 | 4081 | ||
| 4086 | coding.dst_multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 4082 | coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 4087 | if (CODING_MAY_REQUIRE_DECODING (&coding) | 4083 | if (CODING_MAY_REQUIRE_DECODING (&coding) |
| 4088 | && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding))) | 4084 | && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding))) |
| 4089 | { | 4085 | { |
| @@ -4103,18 +4099,6 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4103 | 4099 | ||
| 4104 | /* Now INSERTED is measured in characters. */ | 4100 | /* Now INSERTED is measured in characters. */ |
| 4105 | 4101 | ||
| 4106 | #ifdef DOS_NT | ||
| 4107 | /* Use the conversion type to determine buffer-file-type | ||
| 4108 | (find-buffer-file-type is now used to help determine the | ||
| 4109 | conversion). */ | ||
| 4110 | if ((VECTORP (CODING_ID_EOL_TYPE (coding.id)) | ||
| 4111 | || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)) | ||
| 4112 | && ! CODING_REQUIRE_DECODING (&coding)) | ||
| 4113 | B_ (current_buffer, buffer_file_type) = Qt; | ||
| 4114 | else | ||
| 4115 | B_ (current_buffer, buffer_file_type) = Qnil; | ||
| 4116 | #endif | ||
| 4117 | |||
| 4118 | handled: | 4102 | handled: |
| 4119 | 4103 | ||
| 4120 | if (deferred_remove_unwind_protect) | 4104 | if (deferred_remove_unwind_protect) |
| @@ -4124,24 +4108,24 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4124 | 4108 | ||
| 4125 | if (!NILP (visit)) | 4109 | if (!NILP (visit)) |
| 4126 | { | 4110 | { |
| 4127 | if (!EQ (B_ (current_buffer, undo_list), Qt) && !nochange) | 4111 | if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange) |
| 4128 | B_ (current_buffer, undo_list) = Qnil; | 4112 | BVAR (current_buffer, undo_list) = Qnil; |
| 4129 | 4113 | ||
| 4130 | if (NILP (handler)) | 4114 | if (NILP (handler)) |
| 4131 | { | 4115 | { |
| 4132 | current_buffer->modtime = st.st_mtime; | 4116 | current_buffer->modtime = st.st_mtime; |
| 4133 | current_buffer->modtime_size = st.st_size; | 4117 | current_buffer->modtime_size = st.st_size; |
| 4134 | B_ (current_buffer, filename) = orig_filename; | 4118 | BVAR (current_buffer, filename) = orig_filename; |
| 4135 | } | 4119 | } |
| 4136 | 4120 | ||
| 4137 | SAVE_MODIFF = MODIFF; | 4121 | SAVE_MODIFF = MODIFF; |
| 4138 | BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; | 4122 | BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; |
| 4139 | XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); | 4123 | XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); |
| 4140 | #ifdef CLASH_DETECTION | 4124 | #ifdef CLASH_DETECTION |
| 4141 | if (NILP (handler)) | 4125 | if (NILP (handler)) |
| 4142 | { | 4126 | { |
| 4143 | if (!NILP (B_ (current_buffer, file_truename))) | 4127 | if (!NILP (BVAR (current_buffer, file_truename))) |
| 4144 | unlock_file (B_ (current_buffer, file_truename)); | 4128 | unlock_file (BVAR (current_buffer, file_truename)); |
| 4145 | unlock_file (filename); | 4129 | unlock_file (filename); |
| 4146 | } | 4130 | } |
| 4147 | #endif /* CLASH_DETECTION */ | 4131 | #endif /* CLASH_DETECTION */ |
| @@ -4174,8 +4158,8 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4174 | specbind (Qinhibit_modification_hooks, Qt); | 4158 | specbind (Qinhibit_modification_hooks, Qt); |
| 4175 | 4159 | ||
| 4176 | /* Save old undo list and don't record undo for decoding. */ | 4160 | /* Save old undo list and don't record undo for decoding. */ |
| 4177 | old_undo = B_ (current_buffer, undo_list); | 4161 | old_undo = BVAR (current_buffer, undo_list); |
| 4178 | B_ (current_buffer, undo_list) = Qt; | 4162 | BVAR (current_buffer, undo_list) = Qt; |
| 4179 | 4163 | ||
| 4180 | if (NILP (replace)) | 4164 | if (NILP (replace)) |
| 4181 | { | 4165 | { |
| @@ -4263,7 +4247,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4263 | 4247 | ||
| 4264 | if (NILP (visit)) | 4248 | if (NILP (visit)) |
| 4265 | { | 4249 | { |
| 4266 | B_ (current_buffer, undo_list) = old_undo; | 4250 | BVAR (current_buffer, undo_list) = old_undo; |
| 4267 | if (CONSP (old_undo) && inserted != old_inserted) | 4251 | if (CONSP (old_undo) && inserted != old_inserted) |
| 4268 | { | 4252 | { |
| 4269 | /* Adjust the last undo record for the size change during | 4253 | /* Adjust the last undo record for the size change during |
| @@ -4278,7 +4262,7 @@ variable `last-coding-system-used' to the coding system actually used. */) | |||
| 4278 | else | 4262 | else |
| 4279 | /* If undo_list was Qt before, keep it that way. | 4263 | /* If undo_list was Qt before, keep it that way. |
| 4280 | Otherwise start with an empty undo_list. */ | 4264 | Otherwise start with an empty undo_list. */ |
| 4281 | B_ (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil; | 4265 | BVAR (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil; |
| 4282 | 4266 | ||
| 4283 | unbind_to (count, Qnil); | 4267 | unbind_to (count, Qnil); |
| 4284 | } | 4268 | } |
| @@ -4332,8 +4316,8 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file | |||
| 4332 | Lisp_Object eol_parent = Qnil; | 4316 | Lisp_Object eol_parent = Qnil; |
| 4333 | 4317 | ||
| 4334 | if (auto_saving | 4318 | if (auto_saving |
| 4335 | && NILP (Fstring_equal (B_ (current_buffer, filename), | 4319 | && NILP (Fstring_equal (BVAR (current_buffer, filename), |
| 4336 | B_ (current_buffer, auto_save_file_name)))) | 4320 | BVAR (current_buffer, auto_save_file_name)))) |
| 4337 | { | 4321 | { |
| 4338 | val = Qutf_8_emacs; | 4322 | val = Qutf_8_emacs; |
| 4339 | eol_parent = Qunix; | 4323 | eol_parent = Qunix; |
| @@ -4362,12 +4346,12 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file | |||
| 4362 | int using_default_coding = 0; | 4346 | int using_default_coding = 0; |
| 4363 | int force_raw_text = 0; | 4347 | int force_raw_text = 0; |
| 4364 | 4348 | ||
| 4365 | val = B_ (current_buffer, buffer_file_coding_system); | 4349 | val = BVAR (current_buffer, buffer_file_coding_system); |
| 4366 | if (NILP (val) | 4350 | if (NILP (val) |
| 4367 | || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) | 4351 | || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) |
| 4368 | { | 4352 | { |
| 4369 | val = Qnil; | 4353 | val = Qnil; |
| 4370 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 4354 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 4371 | force_raw_text = 1; | 4355 | force_raw_text = 1; |
| 4372 | } | 4356 | } |
| 4373 | 4357 | ||
| @@ -4388,7 +4372,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file | |||
| 4388 | { | 4372 | { |
| 4389 | /* If we still have not decided a coding system, use the | 4373 | /* If we still have not decided a coding system, use the |
| 4390 | default value of buffer-file-coding-system. */ | 4374 | default value of buffer-file-coding-system. */ |
| 4391 | val = B_ (current_buffer, buffer_file_coding_system); | 4375 | val = BVAR (current_buffer, buffer_file_coding_system); |
| 4392 | using_default_coding = 1; | 4376 | using_default_coding = 1; |
| 4393 | } | 4377 | } |
| 4394 | 4378 | ||
| @@ -4412,9 +4396,9 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file | |||
| 4412 | format, we use that of | 4396 | format, we use that of |
| 4413 | `default-buffer-file-coding-system'. */ | 4397 | `default-buffer-file-coding-system'. */ |
| 4414 | if (! using_default_coding | 4398 | if (! using_default_coding |
| 4415 | && ! NILP (B_ (&buffer_defaults, buffer_file_coding_system))) | 4399 | && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system))) |
| 4416 | val = (coding_inherit_eol_type | 4400 | val = (coding_inherit_eol_type |
| 4417 | (val, B_ (&buffer_defaults, buffer_file_coding_system))); | 4401 | (val, BVAR (&buffer_defaults, buffer_file_coding_system))); |
| 4418 | 4402 | ||
| 4419 | /* If we decide not to encode text, use `raw-text' or one of its | 4403 | /* If we decide not to encode text, use `raw-text' or one of its |
| 4420 | subsidiaries. */ | 4404 | subsidiaries. */ |
| @@ -4425,7 +4409,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file | |||
| 4425 | val = coding_inherit_eol_type (val, eol_parent); | 4409 | val = coding_inherit_eol_type (val, eol_parent); |
| 4426 | setup_coding_system (val, coding); | 4410 | setup_coding_system (val, coding); |
| 4427 | 4411 | ||
| 4428 | if (!STRINGP (start) && !NILP (B_ (current_buffer, selective_display))) | 4412 | if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display))) |
| 4429 | coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; | 4413 | coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; |
| 4430 | return val; | 4414 | return val; |
| 4431 | } | 4415 | } |
| @@ -4484,9 +4468,6 @@ This calls `write-region-annotate-functions' at the start, and | |||
| 4484 | int quietly = !NILP (visit); | 4468 | int quietly = !NILP (visit); |
| 4485 | struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; | 4469 | struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 4486 | struct buffer *given_buffer; | 4470 | struct buffer *given_buffer; |
| 4487 | #ifdef DOS_NT | ||
| 4488 | int buffer_file_type = O_BINARY; | ||
| 4489 | #endif /* DOS_NT */ | ||
| 4490 | struct coding_system coding; | 4471 | struct coding_system coding; |
| 4491 | 4472 | ||
| 4492 | if (current_buffer->base_buffer && visiting) | 4473 | if (current_buffer->base_buffer && visiting) |
| @@ -4529,8 +4510,8 @@ This calls `write-region-annotate-functions' at the start, and | |||
| 4529 | if (visiting) | 4510 | if (visiting) |
| 4530 | { | 4511 | { |
| 4531 | SAVE_MODIFF = MODIFF; | 4512 | SAVE_MODIFF = MODIFF; |
| 4532 | XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); | 4513 | XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); |
| 4533 | B_ (current_buffer, filename) = visit_file; | 4514 | BVAR (current_buffer, filename) = visit_file; |
| 4534 | } | 4515 | } |
| 4535 | UNGCPRO; | 4516 | UNGCPRO; |
| 4536 | return val; | 4517 | return val; |
| @@ -4596,7 +4577,7 @@ This calls `write-region-annotate-functions' at the start, and | |||
| 4596 | desc = -1; | 4577 | desc = -1; |
| 4597 | if (!NILP (append)) | 4578 | if (!NILP (append)) |
| 4598 | #ifdef DOS_NT | 4579 | #ifdef DOS_NT |
| 4599 | desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0); | 4580 | desc = emacs_open (fn, O_WRONLY | O_BINARY, 0); |
| 4600 | #else /* not DOS_NT */ | 4581 | #else /* not DOS_NT */ |
| 4601 | desc = emacs_open (fn, O_WRONLY, 0); | 4582 | desc = emacs_open (fn, O_WRONLY, 0); |
| 4602 | #endif /* not DOS_NT */ | 4583 | #endif /* not DOS_NT */ |
| @@ -4604,7 +4585,7 @@ This calls `write-region-annotate-functions' at the start, and | |||
| 4604 | if (desc < 0 && (NILP (append) || errno == ENOENT)) | 4585 | if (desc < 0 && (NILP (append) || errno == ENOENT)) |
| 4605 | #ifdef DOS_NT | 4586 | #ifdef DOS_NT |
| 4606 | desc = emacs_open (fn, | 4587 | desc = emacs_open (fn, |
| 4607 | O_WRONLY | O_CREAT | buffer_file_type | 4588 | O_WRONLY | O_CREAT | O_BINARY |
| 4608 | | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC), | 4589 | | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC), |
| 4609 | S_IREAD | S_IWRITE); | 4590 | S_IREAD | S_IWRITE); |
| 4610 | #else /* not DOS_NT */ | 4591 | #else /* not DOS_NT */ |
| @@ -4743,15 +4724,15 @@ This calls `write-region-annotate-functions' at the start, and | |||
| 4743 | if (visiting) | 4724 | if (visiting) |
| 4744 | { | 4725 | { |
| 4745 | SAVE_MODIFF = MODIFF; | 4726 | SAVE_MODIFF = MODIFF; |
| 4746 | XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); | 4727 | XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); |
| 4747 | B_ (current_buffer, filename) = visit_file; | 4728 | BVAR (current_buffer, filename) = visit_file; |
| 4748 | update_mode_lines++; | 4729 | update_mode_lines++; |
| 4749 | } | 4730 | } |
| 4750 | else if (quietly) | 4731 | else if (quietly) |
| 4751 | { | 4732 | { |
| 4752 | if (auto_saving | 4733 | if (auto_saving |
| 4753 | && ! NILP (Fstring_equal (B_ (current_buffer, filename), | 4734 | && ! NILP (Fstring_equal (BVAR (current_buffer, filename), |
| 4754 | B_ (current_buffer, auto_save_file_name)))) | 4735 | BVAR (current_buffer, auto_save_file_name)))) |
| 4755 | SAVE_MODIFF = MODIFF; | 4736 | SAVE_MODIFF = MODIFF; |
| 4756 | 4737 | ||
| 4757 | return Qnil; | 4738 | return Qnil; |
| @@ -4833,10 +4814,10 @@ build_annotations (Lisp_Object start, Lisp_Object end) | |||
| 4833 | } | 4814 | } |
| 4834 | 4815 | ||
| 4835 | /* Now do the same for annotation functions implied by the file-format */ | 4816 | /* Now do the same for annotation functions implied by the file-format */ |
| 4836 | if (auto_saving && (!EQ (B_ (current_buffer, auto_save_file_format), Qt))) | 4817 | if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt))) |
| 4837 | p = B_ (current_buffer, auto_save_file_format); | 4818 | p = BVAR (current_buffer, auto_save_file_format); |
| 4838 | else | 4819 | else |
| 4839 | p = B_ (current_buffer, file_format); | 4820 | p = BVAR (current_buffer, file_format); |
| 4840 | for (i = 0; CONSP (p); p = XCDR (p), ++i) | 4821 | for (i = 0; CONSP (p); p = XCDR (p), ++i) |
| 4841 | { | 4822 | { |
| 4842 | struct buffer *given_buffer = current_buffer; | 4823 | struct buffer *given_buffer = current_buffer; |
| @@ -5015,17 +4996,17 @@ See Info node `(elisp)Modification Time' for more details. */) | |||
| 5015 | b = XBUFFER (buf); | 4996 | b = XBUFFER (buf); |
| 5016 | } | 4997 | } |
| 5017 | 4998 | ||
| 5018 | if (!STRINGP (B_ (b, filename))) return Qt; | 4999 | if (!STRINGP (BVAR (b, filename))) return Qt; |
| 5019 | if (b->modtime == 0) return Qt; | 5000 | if (b->modtime == 0) return Qt; |
| 5020 | 5001 | ||
| 5021 | /* If the file name has special constructs in it, | 5002 | /* If the file name has special constructs in it, |
| 5022 | call the corresponding file handler. */ | 5003 | call the corresponding file handler. */ |
| 5023 | handler = Ffind_file_name_handler (B_ (b, filename), | 5004 | handler = Ffind_file_name_handler (BVAR (b, filename), |
| 5024 | Qverify_visited_file_modtime); | 5005 | Qverify_visited_file_modtime); |
| 5025 | if (!NILP (handler)) | 5006 | if (!NILP (handler)) |
| 5026 | return call2 (handler, Qverify_visited_file_modtime, buf); | 5007 | return call2 (handler, Qverify_visited_file_modtime, buf); |
| 5027 | 5008 | ||
| 5028 | filename = ENCODE_FILE (B_ (b, filename)); | 5009 | filename = ENCODE_FILE (BVAR (b, filename)); |
| 5029 | 5010 | ||
| 5030 | if (stat (SSDATA (filename), &st) < 0) | 5011 | if (stat (SSDATA (filename), &st) < 0) |
| 5031 | { | 5012 | { |
| @@ -5093,7 +5074,7 @@ An argument specifies the modification time value to use | |||
| 5093 | struct stat st; | 5074 | struct stat st; |
| 5094 | Lisp_Object handler; | 5075 | Lisp_Object handler; |
| 5095 | 5076 | ||
| 5096 | filename = Fexpand_file_name (B_ (current_buffer, filename), Qnil); | 5077 | filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil); |
| 5097 | 5078 | ||
| 5098 | /* If the file name has special constructs in it, | 5079 | /* If the file name has special constructs in it, |
| 5099 | call the corresponding file handler. */ | 5080 | call the corresponding file handler. */ |
| @@ -5128,7 +5109,7 @@ auto_save_error (Lisp_Object error) | |||
| 5128 | ring_bell (XFRAME (selected_frame)); | 5109 | ring_bell (XFRAME (selected_frame)); |
| 5129 | 5110 | ||
| 5130 | args[0] = build_string ("Auto-saving %s: %s"); | 5111 | args[0] = build_string ("Auto-saving %s: %s"); |
| 5131 | args[1] = B_ (current_buffer, name); | 5112 | args[1] = BVAR (current_buffer, name); |
| 5132 | args[2] = Ferror_message_string (error); | 5113 | args[2] = Ferror_message_string (error); |
| 5133 | msg = Fformat (3, args); | 5114 | msg = Fformat (3, args); |
| 5134 | GCPRO1 (msg); | 5115 | GCPRO1 (msg); |
| @@ -5159,19 +5140,19 @@ auto_save_1 (void) | |||
| 5159 | auto_save_mode_bits = 0666; | 5140 | auto_save_mode_bits = 0666; |
| 5160 | 5141 | ||
| 5161 | /* Get visited file's mode to become the auto save file's mode. */ | 5142 | /* Get visited file's mode to become the auto save file's mode. */ |
| 5162 | if (! NILP (B_ (current_buffer, filename))) | 5143 | if (! NILP (BVAR (current_buffer, filename))) |
| 5163 | { | 5144 | { |
| 5164 | if (stat (SSDATA (B_ (current_buffer, filename)), &st) >= 0) | 5145 | if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0) |
| 5165 | /* But make sure we can overwrite it later! */ | 5146 | /* But make sure we can overwrite it later! */ |
| 5166 | auto_save_mode_bits = st.st_mode | 0600; | 5147 | auto_save_mode_bits = st.st_mode | 0600; |
| 5167 | else if ((modes = Ffile_modes (B_ (current_buffer, filename)), | 5148 | else if ((modes = Ffile_modes (BVAR (current_buffer, filename)), |
| 5168 | INTEGERP (modes))) | 5149 | INTEGERP (modes))) |
| 5169 | /* Remote files don't cooperate with stat. */ | 5150 | /* Remote files don't cooperate with stat. */ |
| 5170 | auto_save_mode_bits = XINT (modes) | 0600; | 5151 | auto_save_mode_bits = XINT (modes) | 0600; |
| 5171 | } | 5152 | } |
| 5172 | 5153 | ||
| 5173 | return | 5154 | return |
| 5174 | Fwrite_region (Qnil, Qnil, B_ (current_buffer, auto_save_file_name), Qnil, | 5155 | Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil, |
| 5175 | NILP (Vauto_save_visited_file_name) ? Qlambda : Qt, | 5156 | NILP (Vauto_save_visited_file_name) ? Qlambda : Qt, |
| 5176 | Qnil, Qnil); | 5157 | Qnil, Qnil); |
| 5177 | } | 5158 | } |
| @@ -5312,18 +5293,18 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) | |||
| 5312 | /* Record all the buffers that have auto save mode | 5293 | /* Record all the buffers that have auto save mode |
| 5313 | in the special file that lists them. For each of these buffers, | 5294 | in the special file that lists them. For each of these buffers, |
| 5314 | Record visited name (if any) and auto save name. */ | 5295 | Record visited name (if any) and auto save name. */ |
| 5315 | if (STRINGP (B_ (b, auto_save_file_name)) | 5296 | if (STRINGP (BVAR (b, auto_save_file_name)) |
| 5316 | && stream != NULL && do_handled_files == 0) | 5297 | && stream != NULL && do_handled_files == 0) |
| 5317 | { | 5298 | { |
| 5318 | BLOCK_INPUT; | 5299 | BLOCK_INPUT; |
| 5319 | if (!NILP (B_ (b, filename))) | 5300 | if (!NILP (BVAR (b, filename))) |
| 5320 | { | 5301 | { |
| 5321 | fwrite (SDATA (B_ (b, filename)), 1, | 5302 | fwrite (SDATA (BVAR (b, filename)), 1, |
| 5322 | SBYTES (B_ (b, filename)), stream); | 5303 | SBYTES (BVAR (b, filename)), stream); |
| 5323 | } | 5304 | } |
| 5324 | putc ('\n', stream); | 5305 | putc ('\n', stream); |
| 5325 | fwrite (SDATA (B_ (b, auto_save_file_name)), 1, | 5306 | fwrite (SDATA (BVAR (b, auto_save_file_name)), 1, |
| 5326 | SBYTES (B_ (b, auto_save_file_name)), stream); | 5307 | SBYTES (BVAR (b, auto_save_file_name)), stream); |
| 5327 | putc ('\n', stream); | 5308 | putc ('\n', stream); |
| 5328 | UNBLOCK_INPUT; | 5309 | UNBLOCK_INPUT; |
| 5329 | } | 5310 | } |
| @@ -5340,13 +5321,13 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) | |||
| 5340 | /* Check for auto save enabled | 5321 | /* Check for auto save enabled |
| 5341 | and file changed since last auto save | 5322 | and file changed since last auto save |
| 5342 | and file changed since last real save. */ | 5323 | and file changed since last real save. */ |
| 5343 | if (STRINGP (B_ (b, auto_save_file_name)) | 5324 | if (STRINGP (BVAR (b, auto_save_file_name)) |
| 5344 | && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) | 5325 | && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) |
| 5345 | && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b) | 5326 | && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b) |
| 5346 | /* -1 means we've turned off autosaving for a while--see below. */ | 5327 | /* -1 means we've turned off autosaving for a while--see below. */ |
| 5347 | && XINT (B_ (b, save_length)) >= 0 | 5328 | && XINT (BVAR (b, save_length)) >= 0 |
| 5348 | && (do_handled_files | 5329 | && (do_handled_files |
| 5349 | || NILP (Ffind_file_name_handler (B_ (b, auto_save_file_name), | 5330 | || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name), |
| 5350 | Qwrite_region)))) | 5331 | Qwrite_region)))) |
| 5351 | { | 5332 | { |
| 5352 | EMACS_TIME before_time, after_time; | 5333 | EMACS_TIME before_time, after_time; |
| @@ -5360,23 +5341,23 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) | |||
| 5360 | 5341 | ||
| 5361 | set_buffer_internal (b); | 5342 | set_buffer_internal (b); |
| 5362 | if (NILP (Vauto_save_include_big_deletions) | 5343 | if (NILP (Vauto_save_include_big_deletions) |
| 5363 | && (XFASTINT (B_ (b, save_length)) * 10 | 5344 | && (XFASTINT (BVAR (b, save_length)) * 10 |
| 5364 | > (BUF_Z (b) - BUF_BEG (b)) * 13) | 5345 | > (BUF_Z (b) - BUF_BEG (b)) * 13) |
| 5365 | /* A short file is likely to change a large fraction; | 5346 | /* A short file is likely to change a large fraction; |
| 5366 | spare the user annoying messages. */ | 5347 | spare the user annoying messages. */ |
| 5367 | && XFASTINT (B_ (b, save_length)) > 5000 | 5348 | && XFASTINT (BVAR (b, save_length)) > 5000 |
| 5368 | /* These messages are frequent and annoying for `*mail*'. */ | 5349 | /* These messages are frequent and annoying for `*mail*'. */ |
| 5369 | && !EQ (B_ (b, filename), Qnil) | 5350 | && !EQ (BVAR (b, filename), Qnil) |
| 5370 | && NILP (no_message)) | 5351 | && NILP (no_message)) |
| 5371 | { | 5352 | { |
| 5372 | /* It has shrunk too much; turn off auto-saving here. */ | 5353 | /* It has shrunk too much; turn off auto-saving here. */ |
| 5373 | minibuffer_auto_raise = orig_minibuffer_auto_raise; | 5354 | minibuffer_auto_raise = orig_minibuffer_auto_raise; |
| 5374 | message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save", | 5355 | message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save", |
| 5375 | B_ (b, name), 1); | 5356 | BVAR (b, name), 1); |
| 5376 | minibuffer_auto_raise = 0; | 5357 | minibuffer_auto_raise = 0; |
| 5377 | /* Turn off auto-saving until there's a real save, | 5358 | /* Turn off auto-saving until there's a real save, |
| 5378 | and prevent any more warnings. */ | 5359 | and prevent any more warnings. */ |
| 5379 | XSETINT (B_ (b, save_length), -1); | 5360 | XSETINT (BVAR (b, save_length), -1); |
| 5380 | Fsleep_for (make_number (1), Qnil); | 5361 | Fsleep_for (make_number (1), Qnil); |
| 5381 | continue; | 5362 | continue; |
| 5382 | } | 5363 | } |
| @@ -5385,7 +5366,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) | |||
| 5385 | internal_condition_case (auto_save_1, Qt, auto_save_error); | 5366 | internal_condition_case (auto_save_1, Qt, auto_save_error); |
| 5386 | auto_saved++; | 5367 | auto_saved++; |
| 5387 | BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b); | 5368 | BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b); |
| 5388 | XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); | 5369 | XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); |
| 5389 | set_buffer_internal (old); | 5370 | set_buffer_internal (old); |
| 5390 | 5371 | ||
| 5391 | EMACS_GET_TIME (after_time); | 5372 | EMACS_GET_TIME (after_time); |
| @@ -5432,7 +5413,7 @@ No auto-save file will be written until the buffer changes again. */) | |||
| 5432 | /* FIXME: This should not be called in indirect buffers, since | 5413 | /* FIXME: This should not be called in indirect buffers, since |
| 5433 | they're not autosaved. */ | 5414 | they're not autosaved. */ |
| 5434 | BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; | 5415 | BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; |
| 5435 | XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); | 5416 | XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); |
| 5436 | current_buffer->auto_save_failure_time = -1; | 5417 | current_buffer->auto_save_failure_time = -1; |
| 5437 | return Qnil; | 5418 | return Qnil; |
| 5438 | } | 5419 | } |
| @@ -5586,11 +5567,6 @@ syms_of_fileio (void) | |||
| 5586 | Qexcl = intern_c_string ("excl"); | 5567 | Qexcl = intern_c_string ("excl"); |
| 5587 | staticpro (&Qexcl); | 5568 | staticpro (&Qexcl); |
| 5588 | 5569 | ||
| 5589 | #ifdef DOS_NT | ||
| 5590 | Qfind_buffer_file_type = intern_c_string ("find-buffer-file-type"); | ||
| 5591 | staticpro (&Qfind_buffer_file_type); | ||
| 5592 | #endif /* DOS_NT */ | ||
| 5593 | |||
| 5594 | DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, | 5570 | DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, |
| 5595 | doc: /* *Coding system for encoding file names. | 5571 | doc: /* *Coding system for encoding file names. |
| 5596 | If it is nil, `default-file-name-coding-system' (which see) is used. */); | 5572 | If it is nil, `default-file-name-coding-system' (which see) is used. */); |
diff --git a/src/filelock.c b/src/filelock.c index 6802880c985..8e18bb7b650 100644 --- a/src/filelock.c +++ b/src/filelock.c | |||
| @@ -637,9 +637,9 @@ unlock_all_files (void) | |||
| 637 | for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) | 637 | for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) |
| 638 | { | 638 | { |
| 639 | b = XBUFFER (XCDR (XCAR (tail))); | 639 | b = XBUFFER (XCDR (XCAR (tail))); |
| 640 | if (STRINGP (B_ (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) | 640 | if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) |
| 641 | { | 641 | { |
| 642 | unlock_file(B_ (b, file_truename)); | 642 | unlock_file(BVAR (b, file_truename)); |
| 643 | } | 643 | } |
| 644 | } | 644 | } |
| 645 | } | 645 | } |
| @@ -652,7 +652,7 @@ or else nothing is done if current buffer isn't visiting a file. */) | |||
| 652 | (Lisp_Object file) | 652 | (Lisp_Object file) |
| 653 | { | 653 | { |
| 654 | if (NILP (file)) | 654 | if (NILP (file)) |
| 655 | file = B_ (current_buffer, file_truename); | 655 | file = BVAR (current_buffer, file_truename); |
| 656 | else | 656 | else |
| 657 | CHECK_STRING (file); | 657 | CHECK_STRING (file); |
| 658 | if (SAVE_MODIFF < MODIFF | 658 | if (SAVE_MODIFF < MODIFF |
| @@ -669,8 +669,8 @@ should not be locked in that case. */) | |||
| 669 | (void) | 669 | (void) |
| 670 | { | 670 | { |
| 671 | if (SAVE_MODIFF < MODIFF | 671 | if (SAVE_MODIFF < MODIFF |
| 672 | && STRINGP (B_ (current_buffer, file_truename))) | 672 | && STRINGP (BVAR (current_buffer, file_truename))) |
| 673 | unlock_file (B_ (current_buffer, file_truename)); | 673 | unlock_file (BVAR (current_buffer, file_truename)); |
| 674 | return Qnil; | 674 | return Qnil; |
| 675 | } | 675 | } |
| 676 | 676 | ||
| @@ -680,8 +680,8 @@ void | |||
| 680 | unlock_buffer (struct buffer *buffer) | 680 | unlock_buffer (struct buffer *buffer) |
| 681 | { | 681 | { |
| 682 | if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) | 682 | if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) |
| 683 | && STRINGP (B_ (buffer, file_truename))) | 683 | && STRINGP (BVAR (buffer, file_truename))) |
| 684 | unlock_file (B_ (buffer, file_truename)); | 684 | unlock_file (BVAR (buffer, file_truename)); |
| 685 | } | 685 | } |
| 686 | 686 | ||
| 687 | DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, | 687 | DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, |
| @@ -2984,7 +2984,7 @@ into shorter lines. */) | |||
| 2984 | SAFE_ALLOCA (encoded, char *, allength); | 2984 | SAFE_ALLOCA (encoded, char *, allength); |
| 2985 | encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg), | 2985 | encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg), |
| 2986 | encoded, length, NILP (no_line_break), | 2986 | encoded, length, NILP (no_line_break), |
| 2987 | !NILP (B_ (current_buffer, enable_multibyte_characters))); | 2987 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 2988 | if (encoded_length > allength) | 2988 | if (encoded_length > allength) |
| 2989 | abort (); | 2989 | abort (); |
| 2990 | 2990 | ||
| @@ -3166,7 +3166,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ | |||
| 3166 | EMACS_INT old_pos = PT; | 3166 | EMACS_INT old_pos = PT; |
| 3167 | EMACS_INT decoded_length; | 3167 | EMACS_INT decoded_length; |
| 3168 | EMACS_INT inserted_chars; | 3168 | EMACS_INT inserted_chars; |
| 3169 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 3169 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 3170 | USE_SAFE_ALLOCA; | 3170 | USE_SAFE_ALLOCA; |
| 3171 | 3171 | ||
| 3172 | validate_region (&beg, &end); | 3172 | validate_region (&beg, &end); |
| @@ -4684,12 +4684,12 @@ guesswork fails. Normally, an error is signaled in such case. */) | |||
| 4684 | { | 4684 | { |
| 4685 | int force_raw_text = 0; | 4685 | int force_raw_text = 0; |
| 4686 | 4686 | ||
| 4687 | coding_system = B_ (XBUFFER (object), buffer_file_coding_system); | 4687 | coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); |
| 4688 | if (NILP (coding_system) | 4688 | if (NILP (coding_system) |
| 4689 | || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) | 4689 | || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) |
| 4690 | { | 4690 | { |
| 4691 | coding_system = Qnil; | 4691 | coding_system = Qnil; |
| 4692 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 4692 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 4693 | force_raw_text = 1; | 4693 | force_raw_text = 1; |
| 4694 | } | 4694 | } |
| 4695 | 4695 | ||
| @@ -4706,11 +4706,11 @@ guesswork fails. Normally, an error is signaled in such case. */) | |||
| 4706 | } | 4706 | } |
| 4707 | 4707 | ||
| 4708 | if (NILP (coding_system) | 4708 | if (NILP (coding_system) |
| 4709 | && !NILP (B_ (XBUFFER (object), buffer_file_coding_system))) | 4709 | && !NILP (BVAR (XBUFFER (object), buffer_file_coding_system))) |
| 4710 | { | 4710 | { |
| 4711 | /* If we still have not decided a coding system, use the | 4711 | /* If we still have not decided a coding system, use the |
| 4712 | default value of buffer-file-coding-system. */ | 4712 | default value of buffer-file-coding-system. */ |
| 4713 | coding_system = B_ (XBUFFER (object), buffer_file_coding_system); | 4713 | coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); |
| 4714 | } | 4714 | } |
| 4715 | 4715 | ||
| 4716 | if (!force_raw_text | 4716 | if (!force_raw_text |
diff --git a/src/font.c b/src/font.c index d67e8465b6a..d77eafb6ad2 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, | |||
| 3637 | Lisp_Object font_object; | 3637 | Lisp_Object font_object; |
| 3638 | 3638 | ||
| 3639 | multibyte = (NILP (string) | 3639 | multibyte = (NILP (string) |
| 3640 | ? ! NILP (B_ (current_buffer, enable_multibyte_characters)) | 3640 | ? ! NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 3641 | : STRING_MULTIBYTE (string)); | 3641 | : STRING_MULTIBYTE (string)); |
| 3642 | if (c < 0) | 3642 | if (c < 0) |
| 3643 | { | 3643 | { |
diff --git a/src/frame.c b/src/frame.c index ac223ac4da0..56e0e7ec919 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -428,20 +428,20 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis | |||
| 428 | if (NILP (mini_window)) | 428 | if (NILP (mini_window)) |
| 429 | { | 429 | { |
| 430 | /* Use default-minibuffer-frame if possible. */ | 430 | /* Use default-minibuffer-frame if possible. */ |
| 431 | if (!FRAMEP (kb->Vdefault_minibuffer_frame) | 431 | if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) |
| 432 | || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) | 432 | || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))) |
| 433 | { | 433 | { |
| 434 | Lisp_Object frame_dummy; | 434 | Lisp_Object frame_dummy; |
| 435 | 435 | ||
| 436 | XSETFRAME (frame_dummy, f); | 436 | XSETFRAME (frame_dummy, f); |
| 437 | GCPRO1 (frame_dummy); | 437 | GCPRO1 (frame_dummy); |
| 438 | /* If there's no minibuffer frame to use, create one. */ | 438 | /* If there's no minibuffer frame to use, create one. */ |
| 439 | kb->Vdefault_minibuffer_frame = | 439 | KVAR (kb, Vdefault_minibuffer_frame) = |
| 440 | call1 (intern ("make-initial-minibuffer-frame"), display); | 440 | call1 (intern ("make-initial-minibuffer-frame"), display); |
| 441 | UNGCPRO; | 441 | UNGCPRO; |
| 442 | } | 442 | } |
| 443 | 443 | ||
| 444 | mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; | 444 | mini_window = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window; |
| 445 | } | 445 | } |
| 446 | 446 | ||
| 447 | f->minibuffer_window = mini_window; | 447 | f->minibuffer_window = mini_window; |
| @@ -889,7 +889,7 @@ to that frame. */) | |||
| 889 | (Lisp_Object event) | 889 | (Lisp_Object event) |
| 890 | { | 890 | { |
| 891 | /* Preserve prefix arg that the command loop just cleared. */ | 891 | /* Preserve prefix arg that the command loop just cleared. */ |
| 892 | current_kboard->Vprefix_arg = Vcurrent_prefix_arg; | 892 | KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg; |
| 893 | call1 (Vrun_hooks, Qmouse_leave_buffer_hook); | 893 | call1 (Vrun_hooks, Qmouse_leave_buffer_hook); |
| 894 | return do_switch_frame (event, 0, 0, Qnil); | 894 | return do_switch_frame (event, 0, 0, Qnil); |
| 895 | } | 895 | } |
| @@ -1526,7 +1526,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) | |||
| 1526 | /* If we've deleted this keyboard's default_minibuffer_frame, try to | 1526 | /* If we've deleted this keyboard's default_minibuffer_frame, try to |
| 1527 | find another one. Prefer minibuffer-only frames, but also notice | 1527 | find another one. Prefer minibuffer-only frames, but also notice |
| 1528 | frames with other windows. */ | 1528 | frames with other windows. */ |
| 1529 | if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame)) | 1529 | if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame))) |
| 1530 | { | 1530 | { |
| 1531 | Lisp_Object frames; | 1531 | Lisp_Object frames; |
| 1532 | 1532 | ||
| @@ -1575,11 +1575,11 @@ delete_frame (Lisp_Object frame, Lisp_Object force) | |||
| 1575 | if (NILP (frame_with_minibuf)) | 1575 | if (NILP (frame_with_minibuf)) |
| 1576 | abort (); | 1576 | abort (); |
| 1577 | 1577 | ||
| 1578 | kb->Vdefault_minibuffer_frame = frame_with_minibuf; | 1578 | KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf; |
| 1579 | } | 1579 | } |
| 1580 | else | 1580 | else |
| 1581 | /* No frames left on this kboard--say no minibuffer either. */ | 1581 | /* No frames left on this kboard--say no minibuffer either. */ |
| 1582 | kb->Vdefault_minibuffer_frame = Qnil; | 1582 | KVAR (kb, Vdefault_minibuffer_frame) = Qnil; |
| 1583 | } | 1583 | } |
| 1584 | 1584 | ||
| 1585 | /* Cause frame titles to update--necessary if we now have just one frame. */ | 1585 | /* Cause frame titles to update--necessary if we now have just one frame. */ |
| @@ -1817,7 +1817,7 @@ make_frame_visible_1 (Lisp_Object window) | |||
| 1817 | w = XWINDOW (window); | 1817 | w = XWINDOW (window); |
| 1818 | 1818 | ||
| 1819 | if (!NILP (w->buffer)) | 1819 | if (!NILP (w->buffer)) |
| 1820 | B_ (XBUFFER (w->buffer), display_time) = Fcurrent_time (); | 1820 | BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time (); |
| 1821 | 1821 | ||
| 1822 | if (!NILP (w->vchild)) | 1822 | if (!NILP (w->vchild)) |
| 1823 | make_frame_visible_1 (w->vchild); | 1823 | make_frame_visible_1 (w->vchild); |
diff --git a/src/fringe.c b/src/fringe.c index 5b7f8833069..d42d6467f31 100644 --- a/src/fringe.c +++ b/src/fringe.c | |||
| @@ -660,7 +660,7 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor) | |||
| 660 | { | 660 | { |
| 661 | Lisp_Object cmap, bm = Qnil; | 661 | Lisp_Object cmap, bm = Qnil; |
| 662 | 662 | ||
| 663 | if ((cmap = B_ (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap)) | 663 | if ((cmap = BVAR (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap)) |
| 664 | { | 664 | { |
| 665 | bm = Fassq (cursor, cmap); | 665 | bm = Fassq (cursor, cmap); |
| 666 | if (CONSP (bm)) | 666 | if (CONSP (bm)) |
| @@ -670,9 +670,9 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor) | |||
| 670 | return lookup_fringe_bitmap (bm); | 670 | return lookup_fringe_bitmap (bm); |
| 671 | } | 671 | } |
| 672 | } | 672 | } |
| 673 | if (EQ (cmap, B_ (&buffer_defaults, fringe_cursor_alist))) | 673 | if (EQ (cmap, BVAR (&buffer_defaults, fringe_cursor_alist))) |
| 674 | return NO_FRINGE_BITMAP; | 674 | return NO_FRINGE_BITMAP; |
| 675 | bm = Fassq (cursor, B_ (&buffer_defaults, fringe_cursor_alist)); | 675 | bm = Fassq (cursor, BVAR (&buffer_defaults, fringe_cursor_alist)); |
| 676 | if (!CONSP (bm) || ((bm = XCDR (bm)), NILP (bm))) | 676 | if (!CONSP (bm) || ((bm = XCDR (bm)), NILP (bm))) |
| 677 | return NO_FRINGE_BITMAP; | 677 | return NO_FRINGE_BITMAP; |
| 678 | return lookup_fringe_bitmap (bm); | 678 | return lookup_fringe_bitmap (bm); |
| @@ -697,7 +697,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in | |||
| 697 | If partial, lookup partial bitmap in default value if not found here. | 697 | If partial, lookup partial bitmap in default value if not found here. |
| 698 | If not partial, or no partial spec is present, use non-partial bitmap. */ | 698 | If not partial, or no partial spec is present, use non-partial bitmap. */ |
| 699 | 699 | ||
| 700 | if ((cmap = B_ (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap)) | 700 | if ((cmap = BVAR (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap)) |
| 701 | { | 701 | { |
| 702 | bm1 = Fassq (bitmap, cmap); | 702 | bm1 = Fassq (bitmap, cmap); |
| 703 | if (CONSP (bm1)) | 703 | if (CONSP (bm1)) |
| @@ -731,10 +731,10 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in | |||
| 731 | } | 731 | } |
| 732 | } | 732 | } |
| 733 | 733 | ||
| 734 | if (!EQ (cmap, B_ (&buffer_defaults, fringe_indicator_alist)) | 734 | if (!EQ (cmap, BVAR (&buffer_defaults, fringe_indicator_alist)) |
| 735 | && !NILP (B_ (&buffer_defaults, fringe_indicator_alist))) | 735 | && !NILP (BVAR (&buffer_defaults, fringe_indicator_alist))) |
| 736 | { | 736 | { |
| 737 | bm2 = Fassq (bitmap, B_ (&buffer_defaults, fringe_indicator_alist)); | 737 | bm2 = Fassq (bitmap, BVAR (&buffer_defaults, fringe_indicator_alist)); |
| 738 | if (CONSP (bm2)) | 738 | if (CONSP (bm2)) |
| 739 | { | 739 | { |
| 740 | if ((bm2 = XCDR (bm2)), !NILP (bm2)) | 740 | if ((bm2 = XCDR (bm2)), !NILP (bm2)) |
| @@ -919,7 +919,7 @@ update_window_fringes (struct window *w, int keep_current_p) | |||
| 919 | return 0; | 919 | return 0; |
| 920 | 920 | ||
| 921 | if (!MINI_WINDOW_P (w) | 921 | if (!MINI_WINDOW_P (w) |
| 922 | && (ind = B_ (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind))) | 922 | && (ind = BVAR (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind))) |
| 923 | { | 923 | { |
| 924 | if (EQ (ind, Qleft) || EQ (ind, Qright)) | 924 | if (EQ (ind, Qleft) || EQ (ind, Qright)) |
| 925 | boundary_top = boundary_bot = arrow_top = arrow_bot = ind; | 925 | boundary_top = boundary_bot = arrow_top = arrow_bot = ind; |
| @@ -988,7 +988,7 @@ update_window_fringes (struct window *w, int keep_current_p) | |||
| 988 | } | 988 | } |
| 989 | } | 989 | } |
| 990 | 990 | ||
| 991 | empty_pos = B_ (XBUFFER (w->buffer), indicate_empty_lines); | 991 | empty_pos = BVAR (XBUFFER (w->buffer), indicate_empty_lines); |
| 992 | if (!NILP (empty_pos) && !EQ (empty_pos, Qright)) | 992 | if (!NILP (empty_pos) && !EQ (empty_pos, Qright)) |
| 993 | empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft; | 993 | empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft; |
| 994 | 994 | ||
diff --git a/src/indent.c b/src/indent.c index b0195b3dec8..85d26520cfb 100644 --- a/src/indent.c +++ b/src/indent.c | |||
| @@ -70,7 +70,7 @@ buffer_display_table (void) | |||
| 70 | { | 70 | { |
| 71 | Lisp_Object thisbuf; | 71 | Lisp_Object thisbuf; |
| 72 | 72 | ||
| 73 | thisbuf = B_ (current_buffer, display_table); | 73 | thisbuf = BVAR (current_buffer, display_table); |
| 74 | if (DISP_TABLE_P (thisbuf)) | 74 | if (DISP_TABLE_P (thisbuf)) |
| 75 | return XCHAR_TABLE (thisbuf); | 75 | return XCHAR_TABLE (thisbuf); |
| 76 | if (DISP_TABLE_P (Vstandard_display_table)) | 76 | if (DISP_TABLE_P (Vstandard_display_table)) |
| @@ -140,9 +140,9 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab) | |||
| 140 | int i; | 140 | int i; |
| 141 | struct Lisp_Vector *widthtab; | 141 | struct Lisp_Vector *widthtab; |
| 142 | 142 | ||
| 143 | if (!VECTORP (B_ (buf, width_table))) | 143 | if (!VECTORP (BVAR (buf, width_table))) |
| 144 | B_ (buf, width_table) = Fmake_vector (make_number (256), make_number (0)); | 144 | BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0)); |
| 145 | widthtab = XVECTOR (B_ (buf, width_table)); | 145 | widthtab = XVECTOR (BVAR (buf, width_table)); |
| 146 | if (widthtab->size != 256) | 146 | if (widthtab->size != 256) |
| 147 | abort (); | 147 | abort (); |
| 148 | 148 | ||
| @@ -156,17 +156,17 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab) | |||
| 156 | static void | 156 | static void |
| 157 | width_run_cache_on_off (void) | 157 | width_run_cache_on_off (void) |
| 158 | { | 158 | { |
| 159 | if (NILP (B_ (current_buffer, cache_long_line_scans)) | 159 | if (NILP (BVAR (current_buffer, cache_long_line_scans)) |
| 160 | /* And, for the moment, this feature doesn't work on multibyte | 160 | /* And, for the moment, this feature doesn't work on multibyte |
| 161 | characters. */ | 161 | characters. */ |
| 162 | || !NILP (B_ (current_buffer, enable_multibyte_characters))) | 162 | || !NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 163 | { | 163 | { |
| 164 | /* It should be off. */ | 164 | /* It should be off. */ |
| 165 | if (current_buffer->width_run_cache) | 165 | if (current_buffer->width_run_cache) |
| 166 | { | 166 | { |
| 167 | free_region_cache (current_buffer->width_run_cache); | 167 | free_region_cache (current_buffer->width_run_cache); |
| 168 | current_buffer->width_run_cache = 0; | 168 | current_buffer->width_run_cache = 0; |
| 169 | B_ (current_buffer, width_table) = Qnil; | 169 | BVAR (current_buffer, width_table) = Qnil; |
| 170 | } | 170 | } |
| 171 | } | 171 | } |
| 172 | else | 172 | else |
| @@ -329,8 +329,8 @@ current_column (void) | |||
| 329 | register int tab_seen; | 329 | register int tab_seen; |
| 330 | int post_tab; | 330 | int post_tab; |
| 331 | register int c; | 331 | register int c; |
| 332 | register int tab_width = XINT (B_ (current_buffer, tab_width)); | 332 | register int tab_width = XINT (BVAR (current_buffer, tab_width)); |
| 333 | int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow)); | 333 | int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); |
| 334 | register struct Lisp_Char_Table *dp = buffer_display_table (); | 334 | register struct Lisp_Char_Table *dp = buffer_display_table (); |
| 335 | 335 | ||
| 336 | if (PT == last_known_column_point | 336 | if (PT == last_known_column_point |
| @@ -417,7 +417,7 @@ current_column (void) | |||
| 417 | col++; | 417 | col++; |
| 418 | else if (c == '\n' | 418 | else if (c == '\n' |
| 419 | || (c == '\r' | 419 | || (c == '\r' |
| 420 | && EQ (B_ (current_buffer, selective_display), Qt))) | 420 | && EQ (BVAR (current_buffer, selective_display), Qt))) |
| 421 | { | 421 | { |
| 422 | ptr++; | 422 | ptr++; |
| 423 | goto start_of_line_found; | 423 | goto start_of_line_found; |
| @@ -512,10 +512,10 @@ check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos) | |||
| 512 | static void | 512 | static void |
| 513 | scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) | 513 | scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) |
| 514 | { | 514 | { |
| 515 | register EMACS_INT tab_width = XINT (B_ (current_buffer, tab_width)); | 515 | register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); |
| 516 | register int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow)); | 516 | register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); |
| 517 | register struct Lisp_Char_Table *dp = buffer_display_table (); | 517 | register struct Lisp_Char_Table *dp = buffer_display_table (); |
| 518 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 518 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 519 | struct composition_it cmp_it; | 519 | struct composition_it cmp_it; |
| 520 | Lisp_Object window; | 520 | Lisp_Object window; |
| 521 | struct window *w; | 521 | struct window *w; |
| @@ -637,7 +637,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) | |||
| 637 | 637 | ||
| 638 | if (c == '\n') | 638 | if (c == '\n') |
| 639 | goto endloop; | 639 | goto endloop; |
| 640 | if (c == '\r' && EQ (B_ (current_buffer, selective_display), Qt)) | 640 | if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt)) |
| 641 | goto endloop; | 641 | goto endloop; |
| 642 | if (c == '\t') | 642 | if (c == '\t') |
| 643 | { | 643 | { |
| @@ -655,7 +655,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) | |||
| 655 | 655 | ||
| 656 | if (c == '\n') | 656 | if (c == '\n') |
| 657 | goto endloop; | 657 | goto endloop; |
| 658 | if (c == '\r' && EQ (B_ (current_buffer, selective_display), Qt)) | 658 | if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt)) |
| 659 | goto endloop; | 659 | goto endloop; |
| 660 | if (c == '\t') | 660 | if (c == '\t') |
| 661 | { | 661 | { |
| @@ -809,7 +809,7 @@ The return value is COLUMN. */) | |||
| 809 | { | 809 | { |
| 810 | int mincol; | 810 | int mincol; |
| 811 | register int fromcol; | 811 | register int fromcol; |
| 812 | register int tab_width = XINT (B_ (current_buffer, tab_width)); | 812 | register int tab_width = XINT (BVAR (current_buffer, tab_width)); |
| 813 | 813 | ||
| 814 | CHECK_NUMBER (column); | 814 | CHECK_NUMBER (column); |
| 815 | if (NILP (minimum)) | 815 | if (NILP (minimum)) |
| @@ -872,7 +872,7 @@ static double | |||
| 872 | position_indentation (register int pos_byte) | 872 | position_indentation (register int pos_byte) |
| 873 | { | 873 | { |
| 874 | register EMACS_INT column = 0; | 874 | register EMACS_INT column = 0; |
| 875 | register EMACS_INT tab_width = XINT (B_ (current_buffer, tab_width)); | 875 | register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); |
| 876 | register unsigned char *p; | 876 | register unsigned char *p; |
| 877 | register unsigned char *stop; | 877 | register unsigned char *stop; |
| 878 | unsigned char *start; | 878 | unsigned char *start; |
| @@ -924,7 +924,7 @@ position_indentation (register int pos_byte) | |||
| 924 | switch (*p++) | 924 | switch (*p++) |
| 925 | { | 925 | { |
| 926 | case 0240: | 926 | case 0240: |
| 927 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 927 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 928 | return column; | 928 | return column; |
| 929 | case ' ': | 929 | case ' ': |
| 930 | column++; | 930 | column++; |
| @@ -934,7 +934,7 @@ position_indentation (register int pos_byte) | |||
| 934 | break; | 934 | break; |
| 935 | default: | 935 | default: |
| 936 | if (ASCII_BYTE_P (p[-1]) | 936 | if (ASCII_BYTE_P (p[-1]) |
| 937 | || NILP (B_ (current_buffer, enable_multibyte_characters))) | 937 | || NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 938 | return column; | 938 | return column; |
| 939 | { | 939 | { |
| 940 | int c; | 940 | int c; |
| @@ -1123,13 +1123,13 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ | |||
| 1123 | register EMACS_INT pos; | 1123 | register EMACS_INT pos; |
| 1124 | EMACS_INT pos_byte; | 1124 | EMACS_INT pos_byte; |
| 1125 | register int c = 0; | 1125 | register int c = 0; |
| 1126 | register EMACS_INT tab_width = XFASTINT (B_ (current_buffer, tab_width)); | 1126 | register EMACS_INT tab_width = XFASTINT (BVAR (current_buffer, tab_width)); |
| 1127 | register int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow)); | 1127 | register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); |
| 1128 | register struct Lisp_Char_Table *dp = window_display_table (win); | 1128 | register struct Lisp_Char_Table *dp = window_display_table (win); |
| 1129 | int selective | 1129 | int selective |
| 1130 | = (INTEGERP (B_ (current_buffer, selective_display)) | 1130 | = (INTEGERP (BVAR (current_buffer, selective_display)) |
| 1131 | ? XINT (B_ (current_buffer, selective_display)) | 1131 | ? XINT (BVAR (current_buffer, selective_display)) |
| 1132 | : !NILP (B_ (current_buffer, selective_display)) ? -1 : 0); | 1132 | : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); |
| 1133 | int selective_rlen | 1133 | int selective_rlen |
| 1134 | = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp)) | 1134 | = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp)) |
| 1135 | ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0); | 1135 | ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0); |
| @@ -1151,7 +1151,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ | |||
| 1151 | EMACS_INT next_width_run = from; | 1151 | EMACS_INT next_width_run = from; |
| 1152 | Lisp_Object window; | 1152 | Lisp_Object window; |
| 1153 | 1153 | ||
| 1154 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 1154 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 1155 | /* If previous char scanned was a wide character, | 1155 | /* If previous char scanned was a wide character, |
| 1156 | this is the column where it ended. Otherwise, this is 0. */ | 1156 | this is the column where it ended. Otherwise, this is 0. */ |
| 1157 | EMACS_INT wide_column_end_hpos = 0; | 1157 | EMACS_INT wide_column_end_hpos = 0; |
| @@ -1170,8 +1170,8 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ | |||
| 1170 | 1170 | ||
| 1171 | width_run_cache_on_off (); | 1171 | width_run_cache_on_off (); |
| 1172 | if (dp == buffer_display_table ()) | 1172 | if (dp == buffer_display_table ()) |
| 1173 | width_table = (VECTORP (B_ (current_buffer, width_table)) | 1173 | width_table = (VECTORP (BVAR (current_buffer, width_table)) |
| 1174 | ? XVECTOR (B_ (current_buffer, width_table))->contents | 1174 | ? XVECTOR (BVAR (current_buffer, width_table))->contents |
| 1175 | : 0); | 1175 | : 0); |
| 1176 | else | 1176 | else |
| 1177 | /* If the window has its own display table, we can't use the width | 1177 | /* 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_ | |||
| 1337 | } | 1337 | } |
| 1338 | 1338 | ||
| 1339 | if (hscroll || truncate | 1339 | if (hscroll || truncate |
| 1340 | || !NILP (B_ (current_buffer, truncate_lines))) | 1340 | || !NILP (BVAR (current_buffer, truncate_lines))) |
| 1341 | { | 1341 | { |
| 1342 | /* Truncating: skip to newline, unless we are already past | 1342 | /* Truncating: skip to newline, unless we are already past |
| 1343 | TO (we need to go back below). */ | 1343 | TO (we need to go back below). */ |
| @@ -1838,9 +1838,9 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w) | |||
| 1838 | EMACS_INT from_byte; | 1838 | EMACS_INT from_byte; |
| 1839 | EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0; | 1839 | EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0; |
| 1840 | int selective | 1840 | int selective |
| 1841 | = (INTEGERP (B_ (current_buffer, selective_display)) | 1841 | = (INTEGERP (BVAR (current_buffer, selective_display)) |
| 1842 | ? XINT (B_ (current_buffer, selective_display)) | 1842 | ? XINT (BVAR (current_buffer, selective_display)) |
| 1843 | : !NILP (B_ (current_buffer, selective_display)) ? -1 : 0); | 1843 | : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); |
| 1844 | Lisp_Object window; | 1844 | Lisp_Object window; |
| 1845 | EMACS_INT start_hpos = 0; | 1845 | EMACS_INT start_hpos = 0; |
| 1846 | int did_motion; | 1846 | int did_motion; |
diff --git a/src/insdel.c b/src/insdel.c index db997fc938e..7fcf9522a33 100644 --- a/src/insdel.c +++ b/src/insdel.c | |||
| @@ -78,7 +78,7 @@ void | |||
| 78 | check_markers (void) | 78 | check_markers (void) |
| 79 | { | 79 | { |
| 80 | register struct Lisp_Marker *tail; | 80 | register struct Lisp_Marker *tail; |
| 81 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 81 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 82 | 82 | ||
| 83 | for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) | 83 | for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) |
| 84 | { | 84 | { |
| @@ -703,7 +703,7 @@ insert_char (int c) | |||
| 703 | unsigned char str[MAX_MULTIBYTE_LENGTH]; | 703 | unsigned char str[MAX_MULTIBYTE_LENGTH]; |
| 704 | int len; | 704 | int len; |
| 705 | 705 | ||
| 706 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 706 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 707 | len = CHAR_STRING (c, str); | 707 | len = CHAR_STRING (c, str); |
| 708 | else | 708 | else |
| 709 | { | 709 | { |
| @@ -891,7 +891,7 @@ insert_1_both (const char *string, | |||
| 891 | if (nchars == 0) | 891 | if (nchars == 0) |
| 892 | return; | 892 | return; |
| 893 | 893 | ||
| 894 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 894 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 895 | nchars = nbytes; | 895 | nchars = nbytes; |
| 896 | 896 | ||
| 897 | if (prepare) | 897 | if (prepare) |
| @@ -1011,7 +1011,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, | |||
| 1011 | /* Make OUTGOING_NBYTES describe the text | 1011 | /* Make OUTGOING_NBYTES describe the text |
| 1012 | as it will be inserted in this buffer. */ | 1012 | as it will be inserted in this buffer. */ |
| 1013 | 1013 | ||
| 1014 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 1014 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1015 | outgoing_nbytes = nchars; | 1015 | outgoing_nbytes = nchars; |
| 1016 | else if (! STRING_MULTIBYTE (string)) | 1016 | else if (! STRING_MULTIBYTE (string)) |
| 1017 | outgoing_nbytes | 1017 | outgoing_nbytes |
| @@ -1034,7 +1034,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, | |||
| 1034 | between single-byte and multibyte. */ | 1034 | between single-byte and multibyte. */ |
| 1035 | copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes, | 1035 | copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes, |
| 1036 | STRING_MULTIBYTE (string), | 1036 | STRING_MULTIBYTE (string), |
| 1037 | ! NILP (B_ (current_buffer, enable_multibyte_characters))); | 1037 | ! NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1038 | 1038 | ||
| 1039 | #ifdef BYTE_COMBINING_DEBUG | 1039 | #ifdef BYTE_COMBINING_DEBUG |
| 1040 | /* We have copied text into the gap, but we have not altered | 1040 | /* 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, | |||
| 1094 | void | 1094 | void |
| 1095 | insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes) | 1095 | insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes) |
| 1096 | { | 1096 | { |
| 1097 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 1097 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1098 | nchars = nbytes; | 1098 | nchars = nbytes; |
| 1099 | 1099 | ||
| 1100 | record_insert (GPT, nchars); | 1100 | record_insert (GPT, nchars); |
| @@ -1162,9 +1162,9 @@ insert_from_buffer_1 (struct buffer *buf, | |||
| 1162 | /* Make OUTGOING_NBYTES describe the text | 1162 | /* Make OUTGOING_NBYTES describe the text |
| 1163 | as it will be inserted in this buffer. */ | 1163 | as it will be inserted in this buffer. */ |
| 1164 | 1164 | ||
| 1165 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 1165 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1166 | outgoing_nbytes = nchars; | 1166 | outgoing_nbytes = nchars; |
| 1167 | else if (NILP (B_ (buf, enable_multibyte_characters))) | 1167 | else if (NILP (BVAR (buf, enable_multibyte_characters))) |
| 1168 | { | 1168 | { |
| 1169 | EMACS_INT outgoing_before_gap = 0; | 1169 | EMACS_INT outgoing_before_gap = 0; |
| 1170 | EMACS_INT outgoing_after_gap = 0; | 1170 | EMACS_INT outgoing_after_gap = 0; |
| @@ -1215,8 +1215,8 @@ insert_from_buffer_1 (struct buffer *buf, | |||
| 1215 | chunk_expanded | 1215 | chunk_expanded |
| 1216 | = copy_text (BUF_BYTE_ADDRESS (buf, from_byte), | 1216 | = copy_text (BUF_BYTE_ADDRESS (buf, from_byte), |
| 1217 | GPT_ADDR, chunk, | 1217 | GPT_ADDR, chunk, |
| 1218 | ! NILP (B_ (buf, enable_multibyte_characters)), | 1218 | ! NILP (BVAR (buf, enable_multibyte_characters)), |
| 1219 | ! NILP (B_ (current_buffer, enable_multibyte_characters))); | 1219 | ! NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1220 | } | 1220 | } |
| 1221 | else | 1221 | else |
| 1222 | chunk_expanded = chunk = 0; | 1222 | chunk_expanded = chunk = 0; |
| @@ -1224,8 +1224,8 @@ insert_from_buffer_1 (struct buffer *buf, | |||
| 1224 | if (chunk < incoming_nbytes) | 1224 | if (chunk < incoming_nbytes) |
| 1225 | copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk), | 1225 | copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk), |
| 1226 | GPT_ADDR + chunk_expanded, incoming_nbytes - chunk, | 1226 | GPT_ADDR + chunk_expanded, incoming_nbytes - chunk, |
| 1227 | ! NILP (B_ (buf, enable_multibyte_characters)), | 1227 | ! NILP (BVAR (buf, enable_multibyte_characters)), |
| 1228 | ! NILP (B_ (current_buffer, enable_multibyte_characters))); | 1228 | ! NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1229 | 1229 | ||
| 1230 | #ifdef BYTE_COMBINING_DEBUG | 1230 | #ifdef BYTE_COMBINING_DEBUG |
| 1231 | /* We have copied text into the gap, but we have not altered | 1231 | /* 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, | |||
| 1320 | adjust_markers_for_insert (from, from_byte, | 1320 | adjust_markers_for_insert (from, from_byte, |
| 1321 | from + len, from_byte + len_byte, 0); | 1321 | from + len, from_byte + len_byte, 0); |
| 1322 | 1322 | ||
| 1323 | if (! EQ (B_ (current_buffer, undo_list), Qt)) | 1323 | if (! EQ (BVAR (current_buffer, undo_list), Qt)) |
| 1324 | { | 1324 | { |
| 1325 | if (nchars_del > 0) | 1325 | if (nchars_del > 0) |
| 1326 | record_delete (from, prev_text); | 1326 | record_delete (from, prev_text); |
| @@ -1481,7 +1481,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, | |||
| 1481 | /* Make OUTGOING_INSBYTES describe the text | 1481 | /* Make OUTGOING_INSBYTES describe the text |
| 1482 | as it will be inserted in this buffer. */ | 1482 | as it will be inserted in this buffer. */ |
| 1483 | 1483 | ||
| 1484 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 1484 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 1485 | outgoing_insbytes = inschars; | 1485 | outgoing_insbytes = inschars; |
| 1486 | else if (! STRING_MULTIBYTE (new)) | 1486 | else if (! STRING_MULTIBYTE (new)) |
| 1487 | outgoing_insbytes | 1487 | outgoing_insbytes |
| @@ -1503,7 +1503,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, | |||
| 1503 | /* Even if we don't record for undo, we must keep the original text | 1503 | /* Even if we don't record for undo, we must keep the original text |
| 1504 | because we may have to recover it because of inappropriate byte | 1504 | because we may have to recover it because of inappropriate byte |
| 1505 | combining. */ | 1505 | combining. */ |
| 1506 | if (! EQ (B_ (current_buffer, undo_list), Qt)) | 1506 | if (! EQ (BVAR (current_buffer, undo_list), Qt)) |
| 1507 | deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); | 1507 | deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); |
| 1508 | 1508 | ||
| 1509 | GAP_SIZE += nbytes_del; | 1509 | GAP_SIZE += nbytes_del; |
| @@ -1530,7 +1530,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, | |||
| 1530 | between single-byte and multibyte. */ | 1530 | between single-byte and multibyte. */ |
| 1531 | copy_text (SDATA (new), GPT_ADDR, insbytes, | 1531 | copy_text (SDATA (new), GPT_ADDR, insbytes, |
| 1532 | STRING_MULTIBYTE (new), | 1532 | STRING_MULTIBYTE (new), |
| 1533 | ! NILP (B_ (current_buffer, enable_multibyte_characters))); | 1533 | ! NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1534 | 1534 | ||
| 1535 | #ifdef BYTE_COMBINING_DEBUG | 1535 | #ifdef BYTE_COMBINING_DEBUG |
| 1536 | /* We have copied text into the gap, but we have not marked | 1536 | /* 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, | |||
| 1543 | abort (); | 1543 | abort (); |
| 1544 | #endif | 1544 | #endif |
| 1545 | 1545 | ||
| 1546 | if (! EQ (B_ (current_buffer, undo_list), Qt)) | 1546 | if (! EQ (BVAR (current_buffer, undo_list), Qt)) |
| 1547 | { | 1547 | { |
| 1548 | /* Record the insertion first, so that when we undo, | 1548 | /* Record the insertion first, so that when we undo, |
| 1549 | the deletion will be undone first. Thus, undo | 1549 | the deletion will be undone first. Thus, undo |
| @@ -1886,7 +1886,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte, | |||
| 1886 | abort (); | 1886 | abort (); |
| 1887 | #endif | 1887 | #endif |
| 1888 | 1888 | ||
| 1889 | if (ret_string || ! EQ (B_ (current_buffer, undo_list), Qt)) | 1889 | if (ret_string || ! EQ (BVAR (current_buffer, undo_list), Qt)) |
| 1890 | deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); | 1890 | deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); |
| 1891 | else | 1891 | else |
| 1892 | deletion = Qnil; | 1892 | deletion = Qnil; |
| @@ -1897,7 +1897,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte, | |||
| 1897 | so that undo handles this after reinserting the text. */ | 1897 | so that undo handles this after reinserting the text. */ |
| 1898 | adjust_markers_for_delete (from, from_byte, to, to_byte); | 1898 | adjust_markers_for_delete (from, from_byte, to, to_byte); |
| 1899 | 1899 | ||
| 1900 | if (! EQ (B_ (current_buffer, undo_list), Qt)) | 1900 | if (! EQ (BVAR (current_buffer, undo_list), Qt)) |
| 1901 | record_delete (from, deletion); | 1901 | record_delete (from, deletion); |
| 1902 | MODIFF++; | 1902 | MODIFF++; |
| 1903 | CHARS_MODIFF = MODIFF; | 1903 | CHARS_MODIFF = MODIFF; |
| @@ -1968,7 +1968,7 @@ modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end, | |||
| 1968 | if (! preserve_chars_modiff) | 1968 | if (! preserve_chars_modiff) |
| 1969 | CHARS_MODIFF = MODIFF; | 1969 | CHARS_MODIFF = MODIFF; |
| 1970 | 1970 | ||
| 1971 | B_ (buffer, point_before_scroll) = Qnil; | 1971 | BVAR (buffer, point_before_scroll) = Qnil; |
| 1972 | 1972 | ||
| 1973 | if (buffer != old_buffer) | 1973 | if (buffer != old_buffer) |
| 1974 | set_buffer_internal (old_buffer); | 1974 | set_buffer_internal (old_buffer); |
| @@ -1990,7 +1990,7 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, | |||
| 1990 | { | 1990 | { |
| 1991 | struct buffer *base_buffer; | 1991 | struct buffer *base_buffer; |
| 1992 | 1992 | ||
| 1993 | if (!NILP (B_ (current_buffer, read_only))) | 1993 | if (!NILP (BVAR (current_buffer, read_only))) |
| 1994 | Fbarf_if_buffer_read_only (); | 1994 | Fbarf_if_buffer_read_only (); |
| 1995 | 1995 | ||
| 1996 | /* Let redisplay consider other windows than selected_window | 1996 | /* Let redisplay consider other windows than selected_window |
| @@ -2022,32 +2022,32 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, | |||
| 2022 | base_buffer = current_buffer; | 2022 | base_buffer = current_buffer; |
| 2023 | 2023 | ||
| 2024 | #ifdef CLASH_DETECTION | 2024 | #ifdef CLASH_DETECTION |
| 2025 | if (!NILP (B_ (base_buffer, file_truename)) | 2025 | if (!NILP (BVAR (base_buffer, file_truename)) |
| 2026 | /* Make binding buffer-file-name to nil effective. */ | 2026 | /* Make binding buffer-file-name to nil effective. */ |
| 2027 | && !NILP (B_ (base_buffer, filename)) | 2027 | && !NILP (BVAR (base_buffer, filename)) |
| 2028 | && SAVE_MODIFF >= MODIFF) | 2028 | && SAVE_MODIFF >= MODIFF) |
| 2029 | lock_file (B_ (base_buffer, file_truename)); | 2029 | lock_file (BVAR (base_buffer, file_truename)); |
| 2030 | #else | 2030 | #else |
| 2031 | /* At least warn if this file has changed on disk since it was visited. */ | 2031 | /* At least warn if this file has changed on disk since it was visited. */ |
| 2032 | if (!NILP (B_ (base_buffer, filename)) | 2032 | if (!NILP (BVAR (base_buffer, filename)) |
| 2033 | && SAVE_MODIFF >= MODIFF | 2033 | && SAVE_MODIFF >= MODIFF |
| 2034 | && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) | 2034 | && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) |
| 2035 | && !NILP (Ffile_exists_p (B_ (base_buffer, filename)))) | 2035 | && !NILP (Ffile_exists_p (BVAR (base_buffer, filename)))) |
| 2036 | call1 (intern ("ask-user-about-supersession-threat"), | 2036 | call1 (intern ("ask-user-about-supersession-threat"), |
| 2037 | B_ (base_buffer,filename)); | 2037 | BVAR (base_buffer,filename)); |
| 2038 | #endif /* not CLASH_DETECTION */ | 2038 | #endif /* not CLASH_DETECTION */ |
| 2039 | 2039 | ||
| 2040 | /* If `select-active-regions' is non-nil, save the region text. */ | 2040 | /* If `select-active-regions' is non-nil, save the region text. */ |
| 2041 | if (!NILP (B_ (current_buffer, mark_active)) | 2041 | if (!NILP (BVAR (current_buffer, mark_active)) |
| 2042 | && !inhibit_modification_hooks | 2042 | && !inhibit_modification_hooks |
| 2043 | && XMARKER (B_ (current_buffer, mark))->buffer | 2043 | && XMARKER (BVAR (current_buffer, mark))->buffer |
| 2044 | && NILP (Vsaved_region_selection) | 2044 | && NILP (Vsaved_region_selection) |
| 2045 | && (EQ (Vselect_active_regions, Qonly) | 2045 | && (EQ (Vselect_active_regions, Qonly) |
| 2046 | ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) | 2046 | ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) |
| 2047 | : (!NILP (Vselect_active_regions) | 2047 | : (!NILP (Vselect_active_regions) |
| 2048 | && !NILP (Vtransient_mark_mode)))) | 2048 | && !NILP (Vtransient_mark_mode)))) |
| 2049 | { | 2049 | { |
| 2050 | EMACS_INT b = XMARKER (B_ (current_buffer, mark))->charpos; | 2050 | EMACS_INT b = XMARKER (BVAR (current_buffer, mark))->charpos; |
| 2051 | EMACS_INT e = PT; | 2051 | EMACS_INT e = PT; |
| 2052 | if (b < e) | 2052 | if (b < e) |
| 2053 | Vsaved_region_selection = make_buffer_string (b, e, 0); | 2053 | Vsaved_region_selection = make_buffer_string (b, e, 0); |
| @@ -2290,7 +2290,7 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, | |||
| 2290 | non-nil, and insertion calls a file handler (e.g. through | 2290 | non-nil, and insertion calls a file handler (e.g. through |
| 2291 | lock_file) which scribbles into a temp file -- cyd */ | 2291 | lock_file) which scribbles into a temp file -- cyd */ |
| 2292 | if (!BUFFERP (combine_after_change_buffer) | 2292 | if (!BUFFERP (combine_after_change_buffer) |
| 2293 | || NILP (B_ (XBUFFER (combine_after_change_buffer), name))) | 2293 | || NILP (BVAR (XBUFFER (combine_after_change_buffer), name))) |
| 2294 | { | 2294 | { |
| 2295 | combine_after_change_list = Qnil; | 2295 | combine_after_change_list = Qnil; |
| 2296 | return Qnil; | 2296 | return Qnil; |
diff --git a/src/intervals.c b/src/intervals.c index de5faf6ce75..6aee6e9d7fa 100644 --- a/src/intervals.c +++ b/src/intervals.c | |||
| @@ -1978,7 +1978,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos) | |||
| 1978 | int have_overlays; | 1978 | int have_overlays; |
| 1979 | EMACS_INT original_position; | 1979 | EMACS_INT original_position; |
| 1980 | 1980 | ||
| 1981 | B_ (current_buffer, point_before_scroll) = Qnil; | 1981 | BVAR (current_buffer, point_before_scroll) = Qnil; |
| 1982 | 1982 | ||
| 1983 | if (charpos == PT) | 1983 | if (charpos == PT) |
| 1984 | return; | 1984 | return; |
| @@ -2342,7 +2342,7 @@ get_local_map (register EMACS_INT position, register struct buffer *buffer, | |||
| 2342 | if (EQ (type, Qkeymap)) | 2342 | if (EQ (type, Qkeymap)) |
| 2343 | return Qnil; | 2343 | return Qnil; |
| 2344 | else | 2344 | else |
| 2345 | return B_ (buffer, keymap); | 2345 | return BVAR (buffer, keymap); |
| 2346 | } | 2346 | } |
| 2347 | 2347 | ||
| 2348 | /* Produce an interval tree reflecting the intervals in | 2348 | /* Produce an interval tree reflecting the intervals in |
diff --git a/src/intervals.h b/src/intervals.h index 3c46c50db79..f6c1c002ce0 100644 --- a/src/intervals.h +++ b/src/intervals.h | |||
| @@ -236,9 +236,9 @@ struct interval | |||
| 236 | and 2 if it is invisible but with an ellipsis. */ | 236 | and 2 if it is invisible but with an ellipsis. */ |
| 237 | 237 | ||
| 238 | #define TEXT_PROP_MEANS_INVISIBLE(prop) \ | 238 | #define TEXT_PROP_MEANS_INVISIBLE(prop) \ |
| 239 | (EQ (B_ (current_buffer, invisibility_spec), Qt) \ | 239 | (EQ (BVAR (current_buffer, invisibility_spec), Qt) \ |
| 240 | ? !NILP (prop) \ | 240 | ? !NILP (prop) \ |
| 241 | : invisible_p (prop, B_ (current_buffer, invisibility_spec))) | 241 | : invisible_p (prop, BVAR (current_buffer, invisibility_spec))) |
| 242 | 242 | ||
| 243 | /* Declared in alloc.c */ | 243 | /* Declared in alloc.c */ |
| 244 | 244 | ||
diff --git a/src/keyboard.c b/src/keyboard.c index 339d32a838a..e9c6d508fa2 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -461,7 +461,7 @@ echo_char (Lisp_Object c) | |||
| 461 | char *ptr = buffer; | 461 | char *ptr = buffer; |
| 462 | Lisp_Object echo_string; | 462 | Lisp_Object echo_string; |
| 463 | 463 | ||
| 464 | echo_string = current_kboard->echo_string; | 464 | echo_string = KVAR (current_kboard, echo_string); |
| 465 | 465 | ||
| 466 | /* If someone has passed us a composite event, use its head symbol. */ | 466 | /* If someone has passed us a composite event, use its head symbol. */ |
| 467 | c = EVENT_HEAD (c); | 467 | c = EVENT_HEAD (c); |
| @@ -528,7 +528,7 @@ echo_char (Lisp_Object c) | |||
| 528 | else if (STRINGP (echo_string)) | 528 | else if (STRINGP (echo_string)) |
| 529 | echo_string = concat2 (echo_string, build_string (" ")); | 529 | echo_string = concat2 (echo_string, build_string (" ")); |
| 530 | 530 | ||
| 531 | current_kboard->echo_string | 531 | KVAR (current_kboard, echo_string) |
| 532 | = concat2 (echo_string, make_string (buffer, ptr - buffer)); | 532 | = concat2 (echo_string, make_string (buffer, ptr - buffer)); |
| 533 | 533 | ||
| 534 | echo_now (); | 534 | echo_now (); |
| @@ -542,31 +542,31 @@ void | |||
| 542 | echo_dash (void) | 542 | echo_dash (void) |
| 543 | { | 543 | { |
| 544 | /* Do nothing if not echoing at all. */ | 544 | /* Do nothing if not echoing at all. */ |
| 545 | if (NILP (current_kboard->echo_string)) | 545 | if (NILP (KVAR (current_kboard, echo_string))) |
| 546 | return; | 546 | return; |
| 547 | 547 | ||
| 548 | if (this_command_key_count == 0) | 548 | if (this_command_key_count == 0) |
| 549 | return; | 549 | return; |
| 550 | 550 | ||
| 551 | if (!current_kboard->immediate_echo | 551 | if (!current_kboard->immediate_echo |
| 552 | && SCHARS (current_kboard->echo_string) == 0) | 552 | && SCHARS (KVAR (current_kboard, echo_string)) == 0) |
| 553 | return; | 553 | return; |
| 554 | 554 | ||
| 555 | /* Do nothing if we just printed a prompt. */ | 555 | /* Do nothing if we just printed a prompt. */ |
| 556 | if (current_kboard->echo_after_prompt | 556 | if (current_kboard->echo_after_prompt |
| 557 | == SCHARS (current_kboard->echo_string)) | 557 | == SCHARS (KVAR (current_kboard, echo_string))) |
| 558 | return; | 558 | return; |
| 559 | 559 | ||
| 560 | /* Do nothing if we have already put a dash at the end. */ | 560 | /* Do nothing if we have already put a dash at the end. */ |
| 561 | if (SCHARS (current_kboard->echo_string) > 1) | 561 | if (SCHARS (KVAR (current_kboard, echo_string)) > 1) |
| 562 | { | 562 | { |
| 563 | Lisp_Object last_char, prev_char, idx; | 563 | Lisp_Object last_char, prev_char, idx; |
| 564 | 564 | ||
| 565 | idx = make_number (SCHARS (current_kboard->echo_string) - 2); | 565 | idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2); |
| 566 | prev_char = Faref (current_kboard->echo_string, idx); | 566 | prev_char = Faref (KVAR (current_kboard, echo_string), idx); |
| 567 | 567 | ||
| 568 | idx = make_number (SCHARS (current_kboard->echo_string) - 1); | 568 | idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1); |
| 569 | last_char = Faref (current_kboard->echo_string, idx); | 569 | last_char = Faref (KVAR (current_kboard, echo_string), idx); |
| 570 | 570 | ||
| 571 | if (XINT (last_char) == '-' && XINT (prev_char) != ' ') | 571 | if (XINT (last_char) == '-' && XINT (prev_char) != ' ') |
| 572 | return; | 572 | return; |
| @@ -574,7 +574,7 @@ echo_dash (void) | |||
| 574 | 574 | ||
| 575 | /* Put a dash at the end of the buffer temporarily, | 575 | /* Put a dash at the end of the buffer temporarily, |
| 576 | but make it go away when the next character is added. */ | 576 | but make it go away when the next character is added. */ |
| 577 | current_kboard->echo_string = concat2 (current_kboard->echo_string, | 577 | KVAR (current_kboard, echo_string) = concat2 (KVAR (current_kboard, echo_string), |
| 578 | build_string ("-")); | 578 | build_string ("-")); |
| 579 | echo_now (); | 579 | echo_now (); |
| 580 | } | 580 | } |
| @@ -617,9 +617,9 @@ echo_now (void) | |||
| 617 | } | 617 | } |
| 618 | 618 | ||
| 619 | echoing = 1; | 619 | echoing = 1; |
| 620 | message3_nolog (current_kboard->echo_string, | 620 | message3_nolog (KVAR (current_kboard, echo_string), |
| 621 | SBYTES (current_kboard->echo_string), | 621 | SBYTES (KVAR (current_kboard, echo_string)), |
| 622 | STRING_MULTIBYTE (current_kboard->echo_string)); | 622 | STRING_MULTIBYTE (KVAR (current_kboard, echo_string))); |
| 623 | echoing = 0; | 623 | echoing = 0; |
| 624 | 624 | ||
| 625 | /* Record in what buffer we echoed, and from which kboard. */ | 625 | /* Record in what buffer we echoed, and from which kboard. */ |
| @@ -637,7 +637,7 @@ cancel_echoing (void) | |||
| 637 | { | 637 | { |
| 638 | current_kboard->immediate_echo = 0; | 638 | current_kboard->immediate_echo = 0; |
| 639 | current_kboard->echo_after_prompt = -1; | 639 | current_kboard->echo_after_prompt = -1; |
| 640 | current_kboard->echo_string = Qnil; | 640 | KVAR (current_kboard, echo_string) = Qnil; |
| 641 | ok_to_echo_at_next_pause = NULL; | 641 | ok_to_echo_at_next_pause = NULL; |
| 642 | echo_kboard = NULL; | 642 | echo_kboard = NULL; |
| 643 | echo_message_buffer = Qnil; | 643 | echo_message_buffer = Qnil; |
| @@ -648,8 +648,8 @@ cancel_echoing (void) | |||
| 648 | static int | 648 | static int |
| 649 | echo_length (void) | 649 | echo_length (void) |
| 650 | { | 650 | { |
| 651 | return (STRINGP (current_kboard->echo_string) | 651 | return (STRINGP (KVAR (current_kboard, echo_string)) |
| 652 | ? SCHARS (current_kboard->echo_string) | 652 | ? SCHARS (KVAR (current_kboard, echo_string)) |
| 653 | : 0); | 653 | : 0); |
| 654 | } | 654 | } |
| 655 | 655 | ||
| @@ -660,9 +660,9 @@ echo_length (void) | |||
| 660 | static void | 660 | static void |
| 661 | echo_truncate (EMACS_INT nchars) | 661 | echo_truncate (EMACS_INT nchars) |
| 662 | { | 662 | { |
| 663 | if (STRINGP (current_kboard->echo_string)) | 663 | if (STRINGP (KVAR (current_kboard, echo_string))) |
| 664 | current_kboard->echo_string | 664 | KVAR (current_kboard, echo_string) |
| 665 | = Fsubstring (current_kboard->echo_string, | 665 | = Fsubstring (KVAR (current_kboard, echo_string), |
| 666 | make_number (0), make_number (nchars)); | 666 | make_number (0), make_number (nchars)); |
| 667 | truncate_echo_area (nchars); | 667 | truncate_echo_area (nchars); |
| 668 | } | 668 | } |
| @@ -993,8 +993,8 @@ cmd_error (Lisp_Object data) | |||
| 993 | Vstandard_input = Qt; | 993 | Vstandard_input = Qt; |
| 994 | Vexecuting_kbd_macro = Qnil; | 994 | Vexecuting_kbd_macro = Qnil; |
| 995 | executing_kbd_macro = Qnil; | 995 | executing_kbd_macro = Qnil; |
| 996 | current_kboard->Vprefix_arg = Qnil; | 996 | KVAR (current_kboard, Vprefix_arg) = Qnil; |
| 997 | current_kboard->Vlast_prefix_arg = Qnil; | 997 | KVAR (current_kboard, Vlast_prefix_arg) = Qnil; |
| 998 | cancel_echoing (); | 998 | cancel_echoing (); |
| 999 | 999 | ||
| 1000 | /* Avoid unquittable loop if data contains a circular list. */ | 1000 | /* Avoid unquittable loop if data contains a circular list. */ |
| @@ -1302,8 +1302,8 @@ command_loop_1 (void) | |||
| 1302 | #endif | 1302 | #endif |
| 1303 | int already_adjusted = 0; | 1303 | int already_adjusted = 0; |
| 1304 | 1304 | ||
| 1305 | current_kboard->Vprefix_arg = Qnil; | 1305 | KVAR (current_kboard, Vprefix_arg) = Qnil; |
| 1306 | current_kboard->Vlast_prefix_arg = Qnil; | 1306 | KVAR (current_kboard, Vlast_prefix_arg) = Qnil; |
| 1307 | Vdeactivate_mark = Qnil; | 1307 | Vdeactivate_mark = Qnil; |
| 1308 | waiting_for_input = 0; | 1308 | waiting_for_input = 0; |
| 1309 | cancel_echoing (); | 1309 | cancel_echoing (); |
| @@ -1331,10 +1331,10 @@ command_loop_1 (void) | |||
| 1331 | } | 1331 | } |
| 1332 | 1332 | ||
| 1333 | /* Do this after running Vpost_command_hook, for consistency. */ | 1333 | /* Do this after running Vpost_command_hook, for consistency. */ |
| 1334 | current_kboard->Vlast_command = Vthis_command; | 1334 | KVAR (current_kboard, Vlast_command) = Vthis_command; |
| 1335 | current_kboard->Vreal_last_command = real_this_command; | 1335 | KVAR (current_kboard, Vreal_last_command) = real_this_command; |
| 1336 | if (!CONSP (last_command_event)) | 1336 | if (!CONSP (last_command_event)) |
| 1337 | current_kboard->Vlast_repeatable_command = real_this_command; | 1337 | KVAR (current_kboard, Vlast_repeatable_command) = real_this_command; |
| 1338 | 1338 | ||
| 1339 | while (1) | 1339 | while (1) |
| 1340 | { | 1340 | { |
| @@ -1504,9 +1504,9 @@ command_loop_1 (void) | |||
| 1504 | keys = Fkey_description (keys, Qnil); | 1504 | keys = Fkey_description (keys, Qnil); |
| 1505 | bitch_at_user (); | 1505 | bitch_at_user (); |
| 1506 | message_with_string ("%s is undefined", keys, 0); | 1506 | message_with_string ("%s is undefined", keys, 0); |
| 1507 | current_kboard->defining_kbd_macro = Qnil; | 1507 | KVAR (current_kboard, defining_kbd_macro) = Qnil; |
| 1508 | update_mode_lines = 1; | 1508 | update_mode_lines = 1; |
| 1509 | current_kboard->Vprefix_arg = Qnil; | 1509 | KVAR (current_kboard, Vprefix_arg) = Qnil; |
| 1510 | } | 1510 | } |
| 1511 | else | 1511 | else |
| 1512 | { | 1512 | { |
| @@ -1523,7 +1523,7 @@ command_loop_1 (void) | |||
| 1523 | } | 1523 | } |
| 1524 | #endif | 1524 | #endif |
| 1525 | 1525 | ||
| 1526 | if (NILP (current_kboard->Vprefix_arg)) /* FIXME: Why? --Stef */ | 1526 | if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ |
| 1527 | Fundo_boundary (); | 1527 | Fundo_boundary (); |
| 1528 | Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil); | 1528 | Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil); |
| 1529 | 1529 | ||
| @@ -1537,7 +1537,7 @@ command_loop_1 (void) | |||
| 1537 | unbind_to (scount, Qnil); | 1537 | unbind_to (scount, Qnil); |
| 1538 | #endif | 1538 | #endif |
| 1539 | } | 1539 | } |
| 1540 | current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg; | 1540 | KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg; |
| 1541 | 1541 | ||
| 1542 | /* Note that the value cell will never directly contain nil | 1542 | /* Note that the value cell will never directly contain nil |
| 1543 | if the symbol is a local variable. */ | 1543 | if the symbol is a local variable. */ |
| @@ -1565,19 +1565,19 @@ command_loop_1 (void) | |||
| 1565 | If the command didn't actually create a prefix arg, | 1565 | If the command didn't actually create a prefix arg, |
| 1566 | but is merely a frame event that is transparent to prefix args, | 1566 | but is merely a frame event that is transparent to prefix args, |
| 1567 | then the above doesn't apply. */ | 1567 | then the above doesn't apply. */ |
| 1568 | if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_event)) | 1568 | if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event)) |
| 1569 | { | 1569 | { |
| 1570 | current_kboard->Vlast_command = Vthis_command; | 1570 | KVAR (current_kboard, Vlast_command) = Vthis_command; |
| 1571 | current_kboard->Vreal_last_command = real_this_command; | 1571 | KVAR (current_kboard, Vreal_last_command) = real_this_command; |
| 1572 | if (!CONSP (last_command_event)) | 1572 | if (!CONSP (last_command_event)) |
| 1573 | current_kboard->Vlast_repeatable_command = real_this_command; | 1573 | KVAR (current_kboard, Vlast_repeatable_command) = real_this_command; |
| 1574 | cancel_echoing (); | 1574 | cancel_echoing (); |
| 1575 | this_command_key_count = 0; | 1575 | this_command_key_count = 0; |
| 1576 | this_command_key_count_reset = 0; | 1576 | this_command_key_count_reset = 0; |
| 1577 | this_single_command_key_start = 0; | 1577 | this_single_command_key_start = 0; |
| 1578 | } | 1578 | } |
| 1579 | 1579 | ||
| 1580 | if (!NILP (B_ (current_buffer, mark_active)) | 1580 | if (!NILP (BVAR (current_buffer, mark_active)) |
| 1581 | && !NILP (Vrun_hooks)) | 1581 | && !NILP (Vrun_hooks)) |
| 1582 | { | 1582 | { |
| 1583 | /* In Emacs 22, setting transient-mark-mode to `only' was a | 1583 | /* In Emacs 22, setting transient-mark-mode to `only' was a |
| @@ -1599,7 +1599,7 @@ command_loop_1 (void) | |||
| 1599 | if (!NILP (Fwindow_system (Qnil)) | 1599 | if (!NILP (Fwindow_system (Qnil)) |
| 1600 | /* Even if mark_active is non-nil, the actual buffer | 1600 | /* Even if mark_active is non-nil, the actual buffer |
| 1601 | marker may not have been set yet (Bug#7044). */ | 1601 | marker may not have been set yet (Bug#7044). */ |
| 1602 | && XMARKER (B_ (current_buffer, mark))->buffer | 1602 | && XMARKER (BVAR (current_buffer, mark))->buffer |
| 1603 | && (EQ (Vselect_active_regions, Qonly) | 1603 | && (EQ (Vselect_active_regions, Qonly) |
| 1604 | ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) | 1604 | ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) |
| 1605 | : (!NILP (Vselect_active_regions) | 1605 | : (!NILP (Vselect_active_regions) |
| @@ -1607,7 +1607,7 @@ command_loop_1 (void) | |||
| 1607 | && !EQ (Vthis_command, Qhandle_switch_frame)) | 1607 | && !EQ (Vthis_command, Qhandle_switch_frame)) |
| 1608 | { | 1608 | { |
| 1609 | EMACS_INT beg = | 1609 | EMACS_INT beg = |
| 1610 | XINT (Fmarker_position (B_ (current_buffer, mark))); | 1610 | XINT (Fmarker_position (BVAR (current_buffer, mark))); |
| 1611 | EMACS_INT end = PT; | 1611 | EMACS_INT end = PT; |
| 1612 | if (beg < end) | 1612 | if (beg < end) |
| 1613 | call2 (Qx_set_selection, QPRIMARY, | 1613 | call2 (Qx_set_selection, QPRIMARY, |
| @@ -1649,8 +1649,8 @@ command_loop_1 (void) | |||
| 1649 | 1649 | ||
| 1650 | /* Install chars successfully executed in kbd macro. */ | 1650 | /* Install chars successfully executed in kbd macro. */ |
| 1651 | 1651 | ||
| 1652 | if (!NILP (current_kboard->defining_kbd_macro) | 1652 | if (!NILP (KVAR (current_kboard, defining_kbd_macro)) |
| 1653 | && NILP (current_kboard->Vprefix_arg)) | 1653 | && NILP (KVAR (current_kboard, Vprefix_arg))) |
| 1654 | finalize_kbd_macro_chars (); | 1654 | finalize_kbd_macro_chars (); |
| 1655 | #if 0 /* This shouldn't be necessary anymore. --lorentey */ | 1655 | #if 0 /* This shouldn't be necessary anymore. --lorentey */ |
| 1656 | if (!was_locked) | 1656 | if (!was_locked) |
| @@ -2461,7 +2461,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2461 | KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame)); | 2461 | KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame)); |
| 2462 | if (kb != current_kboard) | 2462 | if (kb != current_kboard) |
| 2463 | { | 2463 | { |
| 2464 | Lisp_Object link = kb->kbd_queue; | 2464 | Lisp_Object link = KVAR (kb, kbd_queue); |
| 2465 | /* We shouldn't get here if we were in single-kboard mode! */ | 2465 | /* We shouldn't get here if we were in single-kboard mode! */ |
| 2466 | if (single_kboard) | 2466 | if (single_kboard) |
| 2467 | abort (); | 2467 | abort (); |
| @@ -2473,7 +2473,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2473 | abort (); | 2473 | abort (); |
| 2474 | } | 2474 | } |
| 2475 | if (!CONSP (link)) | 2475 | if (!CONSP (link)) |
| 2476 | kb->kbd_queue = Fcons (c, Qnil); | 2476 | KVAR (kb, kbd_queue) = Fcons (c, Qnil); |
| 2477 | else | 2477 | else |
| 2478 | XSETCDR (link, Fcons (c, Qnil)); | 2478 | XSETCDR (link, Fcons (c, Qnil)); |
| 2479 | kb->kbd_queue_has_data = 1; | 2479 | kb->kbd_queue_has_data = 1; |
| @@ -2645,12 +2645,12 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2645 | { | 2645 | { |
| 2646 | if (current_kboard->kbd_queue_has_data) | 2646 | if (current_kboard->kbd_queue_has_data) |
| 2647 | { | 2647 | { |
| 2648 | if (!CONSP (current_kboard->kbd_queue)) | 2648 | if (!CONSP (KVAR (current_kboard, kbd_queue))) |
| 2649 | abort (); | 2649 | abort (); |
| 2650 | c = XCAR (current_kboard->kbd_queue); | 2650 | c = XCAR (KVAR (current_kboard, kbd_queue)); |
| 2651 | current_kboard->kbd_queue | 2651 | KVAR (current_kboard, kbd_queue) |
| 2652 | = XCDR (current_kboard->kbd_queue); | 2652 | = XCDR (KVAR (current_kboard, kbd_queue)); |
| 2653 | if (NILP (current_kboard->kbd_queue)) | 2653 | if (NILP (KVAR (current_kboard, kbd_queue))) |
| 2654 | current_kboard->kbd_queue_has_data = 0; | 2654 | current_kboard->kbd_queue_has_data = 0; |
| 2655 | input_pending = readable_events (0); | 2655 | input_pending = readable_events (0); |
| 2656 | if (EVENT_HAS_PARAMETERS (c) | 2656 | if (EVENT_HAS_PARAMETERS (c) |
| @@ -2712,7 +2712,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2712 | 2712 | ||
| 2713 | if (! NILP (c) && (kb != current_kboard)) | 2713 | if (! NILP (c) && (kb != current_kboard)) |
| 2714 | { | 2714 | { |
| 2715 | Lisp_Object link = kb->kbd_queue; | 2715 | Lisp_Object link = KVAR (kb, kbd_queue); |
| 2716 | if (CONSP (link)) | 2716 | if (CONSP (link)) |
| 2717 | { | 2717 | { |
| 2718 | while (CONSP (XCDR (link))) | 2718 | while (CONSP (XCDR (link))) |
| @@ -2721,7 +2721,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2721 | abort (); | 2721 | abort (); |
| 2722 | } | 2722 | } |
| 2723 | if (!CONSP (link)) | 2723 | if (!CONSP (link)) |
| 2724 | kb->kbd_queue = Fcons (c, Qnil); | 2724 | KVAR (kb, kbd_queue) = Fcons (c, Qnil); |
| 2725 | else | 2725 | else |
| 2726 | XSETCDR (link, Fcons (c, Qnil)); | 2726 | XSETCDR (link, Fcons (c, Qnil)); |
| 2727 | kb->kbd_queue_has_data = 1; | 2727 | kb->kbd_queue_has_data = 1; |
| @@ -2829,15 +2829,15 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2829 | if (XINT (c) == -1) | 2829 | if (XINT (c) == -1) |
| 2830 | goto exit; | 2830 | goto exit; |
| 2831 | 2831 | ||
| 2832 | if ((STRINGP (current_kboard->Vkeyboard_translate_table) | 2832 | if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) |
| 2833 | && SCHARS (current_kboard->Vkeyboard_translate_table) > (unsigned) XFASTINT (c)) | 2833 | && SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)) > (unsigned) XFASTINT (c)) |
| 2834 | || (VECTORP (current_kboard->Vkeyboard_translate_table) | 2834 | || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table)) |
| 2835 | && XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c)) | 2835 | && XVECTOR (KVAR (current_kboard, Vkeyboard_translate_table))->size > (unsigned) XFASTINT (c)) |
| 2836 | || (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table) | 2836 | || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table)) |
| 2837 | && CHARACTERP (c))) | 2837 | && CHARACTERP (c))) |
| 2838 | { | 2838 | { |
| 2839 | Lisp_Object d; | 2839 | Lisp_Object d; |
| 2840 | d = Faref (current_kboard->Vkeyboard_translate_table, c); | 2840 | d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c); |
| 2841 | /* nil in keyboard-translate-table means no translation. */ | 2841 | /* nil in keyboard-translate-table means no translation. */ |
| 2842 | if (!NILP (d)) | 2842 | if (!NILP (d)) |
| 2843 | c = d; | 2843 | c = d; |
| @@ -2918,7 +2918,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2918 | /* Save the echo status. */ | 2918 | /* Save the echo status. */ |
| 2919 | int saved_immediate_echo = current_kboard->immediate_echo; | 2919 | int saved_immediate_echo = current_kboard->immediate_echo; |
| 2920 | struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause; | 2920 | struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause; |
| 2921 | Lisp_Object saved_echo_string = current_kboard->echo_string; | 2921 | Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string); |
| 2922 | int saved_echo_after_prompt = current_kboard->echo_after_prompt; | 2922 | int saved_echo_after_prompt = current_kboard->echo_after_prompt; |
| 2923 | 2923 | ||
| 2924 | #if 0 | 2924 | #if 0 |
| @@ -2973,7 +2973,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 2973 | 2973 | ||
| 2974 | cancel_echoing (); | 2974 | cancel_echoing (); |
| 2975 | ok_to_echo_at_next_pause = saved_ok_to_echo; | 2975 | ok_to_echo_at_next_pause = saved_ok_to_echo; |
| 2976 | current_kboard->echo_string = saved_echo_string; | 2976 | KVAR (current_kboard, echo_string) = saved_echo_string; |
| 2977 | current_kboard->echo_after_prompt = saved_echo_after_prompt; | 2977 | current_kboard->echo_after_prompt = saved_echo_after_prompt; |
| 2978 | if (saved_immediate_echo) | 2978 | if (saved_immediate_echo) |
| 2979 | echo_now (); | 2979 | echo_now (); |
| @@ -3459,7 +3459,7 @@ kbd_buffer_store_event_hold (register struct input_event *event, | |||
| 3459 | 3459 | ||
| 3460 | if (single_kboard && kb != current_kboard) | 3460 | if (single_kboard && kb != current_kboard) |
| 3461 | { | 3461 | { |
| 3462 | kb->kbd_queue | 3462 | KVAR (kb, kbd_queue) |
| 3463 | = Fcons (make_lispy_switch_frame (event->frame_or_window), | 3463 | = Fcons (make_lispy_switch_frame (event->frame_or_window), |
| 3464 | Fcons (make_number (c), Qnil)); | 3464 | Fcons (make_number (c), Qnil)); |
| 3465 | kb->kbd_queue_has_data = 1; | 3465 | kb->kbd_queue_has_data = 1; |
| @@ -5322,13 +5322,13 @@ make_lispy_event (struct input_event *event) | |||
| 5322 | { | 5322 | { |
| 5323 | /* We need to use an alist rather than a vector as the cache | 5323 | /* We need to use an alist rather than a vector as the cache |
| 5324 | since we can't make a vector long enuf. */ | 5324 | since we can't make a vector long enuf. */ |
| 5325 | if (NILP (current_kboard->system_key_syms)) | 5325 | if (NILP (KVAR (current_kboard, system_key_syms))) |
| 5326 | current_kboard->system_key_syms = Fcons (Qnil, Qnil); | 5326 | KVAR (current_kboard, system_key_syms) = Fcons (Qnil, Qnil); |
| 5327 | return modify_event_symbol (event->code, | 5327 | return modify_event_symbol (event->code, |
| 5328 | event->modifiers, | 5328 | event->modifiers, |
| 5329 | Qfunction_key, | 5329 | Qfunction_key, |
| 5330 | current_kboard->Vsystem_key_alist, | 5330 | KVAR (current_kboard, Vsystem_key_alist), |
| 5331 | 0, ¤t_kboard->system_key_syms, | 5331 | 0, &KVAR (current_kboard, system_key_syms), |
| 5332 | (unsigned) -1); | 5332 | (unsigned) -1); |
| 5333 | } | 5333 | } |
| 5334 | 5334 | ||
| @@ -7360,8 +7360,8 @@ menu_bar_items (Lisp_Object old) | |||
| 7360 | /* Yes, use them (if non-nil) as well as the global map. */ | 7360 | /* Yes, use them (if non-nil) as well as the global map. */ |
| 7361 | maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); | 7361 | maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); |
| 7362 | nmaps = 0; | 7362 | nmaps = 0; |
| 7363 | if (!NILP (current_kboard->Voverriding_terminal_local_map)) | 7363 | if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) |
| 7364 | maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; | 7364 | maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); |
| 7365 | if (!NILP (Voverriding_local_map)) | 7365 | if (!NILP (Voverriding_local_map)) |
| 7366 | maps[nmaps++] = Voverriding_local_map; | 7366 | maps[nmaps++] = Voverriding_local_map; |
| 7367 | } | 7367 | } |
| @@ -7897,8 +7897,8 @@ tool_bar_items (Lisp_Object reuse, int *nitems) | |||
| 7897 | /* Yes, use them (if non-nil) as well as the global map. */ | 7897 | /* Yes, use them (if non-nil) as well as the global map. */ |
| 7898 | maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); | 7898 | maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); |
| 7899 | nmaps = 0; | 7899 | nmaps = 0; |
| 7900 | if (!NILP (current_kboard->Voverriding_terminal_local_map)) | 7900 | if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) |
| 7901 | maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; | 7901 | maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); |
| 7902 | if (!NILP (Voverriding_local_map)) | 7902 | if (!NILP (Voverriding_local_map)) |
| 7903 | maps[nmaps++] = Voverriding_local_map; | 7903 | maps[nmaps++] = Voverriding_local_map; |
| 7904 | } | 7904 | } |
| @@ -8608,18 +8608,18 @@ read_char_minibuf_menu_prompt (int commandflag, int nmaps, Lisp_Object *maps) | |||
| 8608 | 8608 | ||
| 8609 | /* Prompt with that and read response. */ | 8609 | /* Prompt with that and read response. */ |
| 8610 | message2_nolog (menu, strlen (menu), | 8610 | message2_nolog (menu, strlen (menu), |
| 8611 | ! NILP (B_ (current_buffer, enable_multibyte_characters))); | 8611 | ! NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 8612 | 8612 | ||
| 8613 | /* Make believe its not a keyboard macro in case the help char | 8613 | /* Make believe its not a keyboard macro in case the help char |
| 8614 | is pressed. Help characters are not recorded because menu prompting | 8614 | is pressed. Help characters are not recorded because menu prompting |
| 8615 | is not used on replay. | 8615 | is not used on replay. |
| 8616 | */ | 8616 | */ |
| 8617 | orig_defn_macro = current_kboard->defining_kbd_macro; | 8617 | orig_defn_macro = KVAR (current_kboard, defining_kbd_macro); |
| 8618 | current_kboard->defining_kbd_macro = Qnil; | 8618 | KVAR (current_kboard, defining_kbd_macro) = Qnil; |
| 8619 | do | 8619 | do |
| 8620 | obj = read_char (commandflag, 0, 0, Qt, 0, NULL); | 8620 | obj = read_char (commandflag, 0, 0, Qt, 0, NULL); |
| 8621 | while (BUFFERP (obj)); | 8621 | while (BUFFERP (obj)); |
| 8622 | current_kboard->defining_kbd_macro = orig_defn_macro; | 8622 | KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro; |
| 8623 | 8623 | ||
| 8624 | if (!INTEGERP (obj)) | 8624 | if (!INTEGERP (obj)) |
| 8625 | return obj; | 8625 | return obj; |
| @@ -8632,7 +8632,7 @@ read_char_minibuf_menu_prompt (int commandflag, int nmaps, Lisp_Object *maps) | |||
| 8632 | && (!INTEGERP (menu_prompt_more_char) | 8632 | && (!INTEGERP (menu_prompt_more_char) |
| 8633 | || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) | 8633 | || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) |
| 8634 | { | 8634 | { |
| 8635 | if (!NILP (current_kboard->defining_kbd_macro)) | 8635 | if (!NILP (KVAR (current_kboard, defining_kbd_macro))) |
| 8636 | store_kbd_macro_char (obj); | 8636 | store_kbd_macro_char (obj); |
| 8637 | return obj; | 8637 | return obj; |
| 8638 | } | 8638 | } |
| @@ -8974,7 +8974,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, | |||
| 8974 | /* Install the string STR as the beginning of the string of | 8974 | /* Install the string STR as the beginning of the string of |
| 8975 | echoing, so that it serves as a prompt for the next | 8975 | echoing, so that it serves as a prompt for the next |
| 8976 | character. */ | 8976 | character. */ |
| 8977 | current_kboard->echo_string = prompt; | 8977 | KVAR (current_kboard, echo_string) = prompt; |
| 8978 | current_kboard->echo_after_prompt = SCHARS (prompt); | 8978 | current_kboard->echo_after_prompt = SCHARS (prompt); |
| 8979 | echo_now (); | 8979 | echo_now (); |
| 8980 | } | 8980 | } |
| @@ -9012,8 +9012,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, | |||
| 9012 | happens if we switch keyboards between rescans. */ | 9012 | happens if we switch keyboards between rescans. */ |
| 9013 | replay_entire_sequence: | 9013 | replay_entire_sequence: |
| 9014 | 9014 | ||
| 9015 | indec.map = indec.parent = current_kboard->Vinput_decode_map; | 9015 | indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map); |
| 9016 | fkey.map = fkey.parent = current_kboard->Vlocal_function_key_map; | 9016 | fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map); |
| 9017 | keytran.map = keytran.parent = Vkey_translation_map; | 9017 | keytran.map = keytran.parent = Vkey_translation_map; |
| 9018 | indec.start = indec.end = 0; | 9018 | indec.start = indec.end = 0; |
| 9019 | fkey.start = fkey.end = 0; | 9019 | fkey.start = fkey.end = 0; |
| @@ -9034,7 +9034,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, | |||
| 9034 | the initial keymaps from the current buffer. */ | 9034 | the initial keymaps from the current buffer. */ |
| 9035 | nmaps = 0; | 9035 | nmaps = 0; |
| 9036 | 9036 | ||
| 9037 | if (!NILP (current_kboard->Voverriding_terminal_local_map)) | 9037 | if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) |
| 9038 | { | 9038 | { |
| 9039 | if (2 > nmaps_allocated) | 9039 | if (2 > nmaps_allocated) |
| 9040 | { | 9040 | { |
| @@ -9042,7 +9042,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, | |||
| 9042 | defs = (Lisp_Object *) alloca (2 * sizeof (defs[0])); | 9042 | defs = (Lisp_Object *) alloca (2 * sizeof (defs[0])); |
| 9043 | nmaps_allocated = 2; | 9043 | nmaps_allocated = 2; |
| 9044 | } | 9044 | } |
| 9045 | submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map; | 9045 | submaps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); |
| 9046 | } | 9046 | } |
| 9047 | else if (!NILP (Voverriding_local_map)) | 9047 | else if (!NILP (Voverriding_local_map)) |
| 9048 | { | 9048 | { |
| @@ -9218,29 +9218,29 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, | |||
| 9218 | 9218 | ||
| 9219 | if (!NILP (delayed_switch_frame)) | 9219 | if (!NILP (delayed_switch_frame)) |
| 9220 | { | 9220 | { |
| 9221 | interrupted_kboard->kbd_queue | 9221 | KVAR (interrupted_kboard, kbd_queue) |
| 9222 | = Fcons (delayed_switch_frame, | 9222 | = Fcons (delayed_switch_frame, |
| 9223 | interrupted_kboard->kbd_queue); | 9223 | KVAR (interrupted_kboard, kbd_queue)); |
| 9224 | delayed_switch_frame = Qnil; | 9224 | delayed_switch_frame = Qnil; |
| 9225 | } | 9225 | } |
| 9226 | 9226 | ||
| 9227 | while (t > 0) | 9227 | while (t > 0) |
| 9228 | interrupted_kboard->kbd_queue | 9228 | KVAR (interrupted_kboard, kbd_queue) |
| 9229 | = Fcons (keybuf[--t], interrupted_kboard->kbd_queue); | 9229 | = Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)); |
| 9230 | 9230 | ||
| 9231 | /* If the side queue is non-empty, ensure it begins with a | 9231 | /* If the side queue is non-empty, ensure it begins with a |
| 9232 | switch-frame, so we'll replay it in the right context. */ | 9232 | switch-frame, so we'll replay it in the right context. */ |
| 9233 | if (CONSP (interrupted_kboard->kbd_queue) | 9233 | if (CONSP (KVAR (interrupted_kboard, kbd_queue)) |
| 9234 | && (key = XCAR (interrupted_kboard->kbd_queue), | 9234 | && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)), |
| 9235 | !(EVENT_HAS_PARAMETERS (key) | 9235 | !(EVENT_HAS_PARAMETERS (key) |
| 9236 | && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), | 9236 | && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), |
| 9237 | Qswitch_frame)))) | 9237 | Qswitch_frame)))) |
| 9238 | { | 9238 | { |
| 9239 | Lisp_Object frame; | 9239 | Lisp_Object frame; |
| 9240 | XSETFRAME (frame, interrupted_frame); | 9240 | XSETFRAME (frame, interrupted_frame); |
| 9241 | interrupted_kboard->kbd_queue | 9241 | KVAR (interrupted_kboard, kbd_queue) |
| 9242 | = Fcons (make_lispy_switch_frame (frame), | 9242 | = Fcons (make_lispy_switch_frame (frame), |
| 9243 | interrupted_kboard->kbd_queue); | 9243 | KVAR (interrupted_kboard, kbd_queue)); |
| 9244 | } | 9244 | } |
| 9245 | mock_input = 0; | 9245 | mock_input = 0; |
| 9246 | orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); | 9246 | orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); |
| @@ -9870,7 +9870,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, | |||
| 9870 | /* Treat uppercase keys as shifted. */ | 9870 | /* Treat uppercase keys as shifted. */ |
| 9871 | || (INTEGERP (key) | 9871 | || (INTEGERP (key) |
| 9872 | && (KEY_TO_CHAR (key) | 9872 | && (KEY_TO_CHAR (key) |
| 9873 | < XCHAR_TABLE (B_ (current_buffer, downcase_table))->size) | 9873 | < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->size) |
| 9874 | && UPPERCASEP (KEY_TO_CHAR (key)))) | 9874 | && UPPERCASEP (KEY_TO_CHAR (key)))) |
| 9875 | { | 9875 | { |
| 9876 | Lisp_Object new_key | 9876 | Lisp_Object new_key |
| @@ -10115,9 +10115,9 @@ a special event, so ignore the prefix argument and don't clear it. */) | |||
| 10115 | 10115 | ||
| 10116 | if (NILP (special)) | 10116 | if (NILP (special)) |
| 10117 | { | 10117 | { |
| 10118 | prefixarg = current_kboard->Vprefix_arg; | 10118 | prefixarg = KVAR (current_kboard, Vprefix_arg); |
| 10119 | Vcurrent_prefix_arg = prefixarg; | 10119 | Vcurrent_prefix_arg = prefixarg; |
| 10120 | current_kboard->Vprefix_arg = Qnil; | 10120 | KVAR (current_kboard, Vprefix_arg) = Qnil; |
| 10121 | } | 10121 | } |
| 10122 | else | 10122 | else |
| 10123 | prefixarg = Qnil; | 10123 | prefixarg = Qnil; |
| @@ -10251,7 +10251,7 @@ give to the command you invoke, if it asks for an argument. */) | |||
| 10251 | UNGCPRO; | 10251 | UNGCPRO; |
| 10252 | 10252 | ||
| 10253 | function = Fintern (function, Qnil); | 10253 | function = Fintern (function, Qnil); |
| 10254 | current_kboard->Vprefix_arg = prefixarg; | 10254 | KVAR (current_kboard, Vprefix_arg) = prefixarg; |
| 10255 | Vthis_command = function; | 10255 | Vthis_command = function; |
| 10256 | real_this_command = function; | 10256 | real_this_command = function; |
| 10257 | 10257 | ||
| @@ -10574,7 +10574,7 @@ DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0, | |||
| 10574 | Also end any kbd macro being defined. */) | 10574 | Also end any kbd macro being defined. */) |
| 10575 | (void) | 10575 | (void) |
| 10576 | { | 10576 | { |
| 10577 | if (!NILP (current_kboard->defining_kbd_macro)) | 10577 | if (!NILP (KVAR (current_kboard, defining_kbd_macro))) |
| 10578 | { | 10578 | { |
| 10579 | /* Discard the last command from the macro. */ | 10579 | /* Discard the last command from the macro. */ |
| 10580 | Fcancel_kbd_macro_events (); | 10580 | Fcancel_kbd_macro_events (); |
| @@ -11224,30 +11224,30 @@ The `posn-' functions access elements of such lists. */) | |||
| 11224 | void | 11224 | void |
| 11225 | init_kboard (KBOARD *kb) | 11225 | init_kboard (KBOARD *kb) |
| 11226 | { | 11226 | { |
| 11227 | kb->Voverriding_terminal_local_map = Qnil; | 11227 | KVAR (kb, Voverriding_terminal_local_map) = Qnil; |
| 11228 | kb->Vlast_command = Qnil; | 11228 | KVAR (kb, Vlast_command) = Qnil; |
| 11229 | kb->Vreal_last_command = Qnil; | 11229 | KVAR (kb, Vreal_last_command) = Qnil; |
| 11230 | kb->Vkeyboard_translate_table = Qnil; | 11230 | KVAR (kb, Vkeyboard_translate_table) = Qnil; |
| 11231 | kb->Vlast_repeatable_command = Qnil; | 11231 | KVAR (kb, Vlast_repeatable_command) = Qnil; |
| 11232 | kb->Vprefix_arg = Qnil; | 11232 | KVAR (kb, Vprefix_arg) = Qnil; |
| 11233 | kb->Vlast_prefix_arg = Qnil; | 11233 | KVAR (kb, Vlast_prefix_arg) = Qnil; |
| 11234 | kb->kbd_queue = Qnil; | 11234 | KVAR (kb, kbd_queue) = Qnil; |
| 11235 | kb->kbd_queue_has_data = 0; | 11235 | kb->kbd_queue_has_data = 0; |
| 11236 | kb->immediate_echo = 0; | 11236 | kb->immediate_echo = 0; |
| 11237 | kb->echo_string = Qnil; | 11237 | KVAR (kb, echo_string) = Qnil; |
| 11238 | kb->echo_after_prompt = -1; | 11238 | kb->echo_after_prompt = -1; |
| 11239 | kb->kbd_macro_buffer = 0; | 11239 | kb->kbd_macro_buffer = 0; |
| 11240 | kb->kbd_macro_bufsize = 0; | 11240 | kb->kbd_macro_bufsize = 0; |
| 11241 | kb->defining_kbd_macro = Qnil; | 11241 | KVAR (kb, defining_kbd_macro) = Qnil; |
| 11242 | kb->Vlast_kbd_macro = Qnil; | 11242 | KVAR (kb, Vlast_kbd_macro) = Qnil; |
| 11243 | kb->reference_count = 0; | 11243 | kb->reference_count = 0; |
| 11244 | kb->Vsystem_key_alist = Qnil; | 11244 | KVAR (kb, Vsystem_key_alist) = Qnil; |
| 11245 | kb->system_key_syms = Qnil; | 11245 | KVAR (kb, system_key_syms) = Qnil; |
| 11246 | kb->Vwindow_system = Qt; /* Unset. */ | 11246 | KVAR (kb, Vwindow_system) = Qt; /* Unset. */ |
| 11247 | kb->Vinput_decode_map = Fmake_sparse_keymap (Qnil); | 11247 | KVAR (kb, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); |
| 11248 | kb->Vlocal_function_key_map = Fmake_sparse_keymap (Qnil); | 11248 | KVAR (kb, Vlocal_function_key_map) = Fmake_sparse_keymap (Qnil); |
| 11249 | Fset_keymap_parent (kb->Vlocal_function_key_map, Vfunction_key_map); | 11249 | Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map); |
| 11250 | kb->Vdefault_minibuffer_frame = Qnil; | 11250 | KVAR (kb, Vdefault_minibuffer_frame) = Qnil; |
| 11251 | } | 11251 | } |
| 11252 | 11252 | ||
| 11253 | /* | 11253 | /* |
| @@ -11323,7 +11323,7 @@ init_keyboard (void) | |||
| 11323 | init_kboard (current_kboard); | 11323 | init_kboard (current_kboard); |
| 11324 | /* A value of nil for Vwindow_system normally means a tty, but we also use | 11324 | /* A value of nil for Vwindow_system normally means a tty, but we also use |
| 11325 | it for the initial terminal since there is no window system there. */ | 11325 | it for the initial terminal since there is no window system there. */ |
| 11326 | current_kboard->Vwindow_system = Qnil; | 11326 | KVAR (current_kboard, Vwindow_system) = Qnil; |
| 11327 | 11327 | ||
| 11328 | if (!noninteractive) | 11328 | if (!noninteractive) |
| 11329 | { | 11329 | { |
| @@ -12266,23 +12266,23 @@ mark_kboards (void) | |||
| 12266 | if (kb->kbd_macro_buffer) | 12266 | if (kb->kbd_macro_buffer) |
| 12267 | for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) | 12267 | for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) |
| 12268 | mark_object (*p); | 12268 | mark_object (*p); |
| 12269 | mark_object (kb->Voverriding_terminal_local_map); | 12269 | mark_object (KVAR (kb, Voverriding_terminal_local_map)); |
| 12270 | mark_object (kb->Vlast_command); | 12270 | mark_object (KVAR (kb, Vlast_command)); |
| 12271 | mark_object (kb->Vreal_last_command); | 12271 | mark_object (KVAR (kb, Vreal_last_command)); |
| 12272 | mark_object (kb->Vkeyboard_translate_table); | 12272 | mark_object (KVAR (kb, Vkeyboard_translate_table)); |
| 12273 | mark_object (kb->Vlast_repeatable_command); | 12273 | mark_object (KVAR (kb, Vlast_repeatable_command)); |
| 12274 | mark_object (kb->Vprefix_arg); | 12274 | mark_object (KVAR (kb, Vprefix_arg)); |
| 12275 | mark_object (kb->Vlast_prefix_arg); | 12275 | mark_object (KVAR (kb, Vlast_prefix_arg)); |
| 12276 | mark_object (kb->kbd_queue); | 12276 | mark_object (KVAR (kb, kbd_queue)); |
| 12277 | mark_object (kb->defining_kbd_macro); | 12277 | mark_object (KVAR (kb, defining_kbd_macro)); |
| 12278 | mark_object (kb->Vlast_kbd_macro); | 12278 | mark_object (KVAR (kb, Vlast_kbd_macro)); |
| 12279 | mark_object (kb->Vsystem_key_alist); | 12279 | mark_object (KVAR (kb, Vsystem_key_alist)); |
| 12280 | mark_object (kb->system_key_syms); | 12280 | mark_object (KVAR (kb, system_key_syms)); |
| 12281 | mark_object (kb->Vwindow_system); | 12281 | mark_object (KVAR (kb, Vwindow_system)); |
| 12282 | mark_object (kb->Vinput_decode_map); | 12282 | mark_object (KVAR (kb, Vinput_decode_map)); |
| 12283 | mark_object (kb->Vlocal_function_key_map); | 12283 | mark_object (KVAR (kb, Vlocal_function_key_map)); |
| 12284 | mark_object (kb->Vdefault_minibuffer_frame); | 12284 | mark_object (KVAR (kb, Vdefault_minibuffer_frame)); |
| 12285 | mark_object (kb->echo_string); | 12285 | mark_object (KVAR (kb, echo_string)); |
| 12286 | } | 12286 | } |
| 12287 | { | 12287 | { |
| 12288 | struct input_event *event; | 12288 | struct input_event *event; |
diff --git a/src/keyboard.h b/src/keyboard.h index 7b3374ac3bd..10bf16d5c5c 100644 --- a/src/keyboard.h +++ b/src/keyboard.h | |||
| @@ -19,6 +19,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 19 | #include "systime.h" /* for EMACS_TIME */ | 19 | #include "systime.h" /* for EMACS_TIME */ |
| 20 | #include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */ | 20 | #include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */ |
| 21 | 21 | ||
| 22 | /* Lisp fields in struct keyboard are hidden from most code and accessed | ||
| 23 | via the KVAR macro, below. Only select pieces of code, like the GC, | ||
| 24 | are allowed to use KBOARD_INTERNAL_FIELD. */ | ||
| 25 | #define KBOARD_INTERNAL_FIELD(field) field ## _ | ||
| 26 | |||
| 27 | /* Most code should use this macro to access Lisp fields in struct | ||
| 28 | kboard. */ | ||
| 29 | #define KVAR(kboard, field) ((kboard)->KBOARD_INTERNAL_FIELD (field)) | ||
| 30 | |||
| 22 | /* Each KBOARD represents one logical input stream from which Emacs | 31 | /* Each KBOARD represents one logical input stream from which Emacs |
| 23 | gets input. If we are using ordinary terminals, it has one KBOARD | 32 | gets input. If we are using ordinary terminals, it has one KBOARD |
| 24 | object for each terminal device. | 33 | object for each terminal device. |
| @@ -70,32 +79,32 @@ struct kboard | |||
| 70 | can effectively wait for input in the any-kboard state, and hence | 79 | can effectively wait for input in the any-kboard state, and hence |
| 71 | avoid blocking out the other KBOARDs. See universal-argument in | 80 | avoid blocking out the other KBOARDs. See universal-argument in |
| 72 | lisp/simple.el for an example. */ | 81 | lisp/simple.el for an example. */ |
| 73 | Lisp_Object Voverriding_terminal_local_map; | 82 | Lisp_Object KBOARD_INTERNAL_FIELD (Voverriding_terminal_local_map); |
| 74 | 83 | ||
| 75 | /* Last command executed by the editor command loop, not counting | 84 | /* Last command executed by the editor command loop, not counting |
| 76 | commands that set the prefix argument. */ | 85 | commands that set the prefix argument. */ |
| 77 | Lisp_Object Vlast_command; | 86 | Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_command); |
| 78 | 87 | ||
| 79 | /* Normally same as last-command, but never modified by other commands. */ | 88 | /* Normally same as last-command, but never modified by other commands. */ |
| 80 | Lisp_Object Vreal_last_command; | 89 | Lisp_Object KBOARD_INTERNAL_FIELD (Vreal_last_command); |
| 81 | 90 | ||
| 82 | /* User-supplied table to translate input characters through. */ | 91 | /* User-supplied table to translate input characters through. */ |
| 83 | Lisp_Object Vkeyboard_translate_table; | 92 | Lisp_Object KBOARD_INTERNAL_FIELD (Vkeyboard_translate_table); |
| 84 | 93 | ||
| 85 | /* Last command that may be repeated by `repeat'. */ | 94 | /* Last command that may be repeated by `repeat'. */ |
| 86 | Lisp_Object Vlast_repeatable_command; | 95 | Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_repeatable_command); |
| 87 | 96 | ||
| 88 | /* The prefix argument for the next command, in raw form. */ | 97 | /* The prefix argument for the next command, in raw form. */ |
| 89 | Lisp_Object Vprefix_arg; | 98 | Lisp_Object KBOARD_INTERNAL_FIELD (Vprefix_arg); |
| 90 | 99 | ||
| 91 | /* Saved prefix argument for the last command, in raw form. */ | 100 | /* Saved prefix argument for the last command, in raw form. */ |
| 92 | Lisp_Object Vlast_prefix_arg; | 101 | Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_prefix_arg); |
| 93 | 102 | ||
| 94 | /* Unread events specific to this kboard. */ | 103 | /* Unread events specific to this kboard. */ |
| 95 | Lisp_Object kbd_queue; | 104 | Lisp_Object KBOARD_INTERNAL_FIELD (kbd_queue); |
| 96 | 105 | ||
| 97 | /* Non-nil while a kbd macro is being defined. */ | 106 | /* Non-nil while a kbd macro is being defined. */ |
| 98 | Lisp_Object defining_kbd_macro; | 107 | Lisp_Object KBOARD_INTERNAL_FIELD (defining_kbd_macro); |
| 99 | 108 | ||
| 100 | /* The start of storage for the current keyboard macro. */ | 109 | /* The start of storage for the current keyboard macro. */ |
| 101 | Lisp_Object *kbd_macro_buffer; | 110 | Lisp_Object *kbd_macro_buffer; |
| @@ -117,28 +126,28 @@ struct kboard | |||
| 117 | int kbd_macro_bufsize; | 126 | int kbd_macro_bufsize; |
| 118 | 127 | ||
| 119 | /* Last anonymous kbd macro defined. */ | 128 | /* Last anonymous kbd macro defined. */ |
| 120 | Lisp_Object Vlast_kbd_macro; | 129 | Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro); |
| 121 | 130 | ||
| 122 | /* Alist of system-specific X windows key symbols. */ | 131 | /* Alist of system-specific X windows key symbols. */ |
| 123 | Lisp_Object Vsystem_key_alist; | 132 | Lisp_Object KBOARD_INTERNAL_FIELD (Vsystem_key_alist); |
| 124 | 133 | ||
| 125 | /* Cache for modify_event_symbol. */ | 134 | /* Cache for modify_event_symbol. */ |
| 126 | Lisp_Object system_key_syms; | 135 | Lisp_Object KBOARD_INTERNAL_FIELD (system_key_syms); |
| 127 | 136 | ||
| 128 | /* The kind of display: x, w32, ... */ | 137 | /* The kind of display: x, w32, ... */ |
| 129 | Lisp_Object Vwindow_system; | 138 | Lisp_Object KBOARD_INTERNAL_FIELD (Vwindow_system); |
| 130 | 139 | ||
| 131 | /* Keymap mapping keys to alternative preferred forms. | 140 | /* Keymap mapping keys to alternative preferred forms. |
| 132 | See the DEFVAR for more documentation. */ | 141 | See the DEFVAR for more documentation. */ |
| 133 | Lisp_Object Vlocal_function_key_map; | 142 | Lisp_Object KBOARD_INTERNAL_FIELD (Vlocal_function_key_map); |
| 134 | 143 | ||
| 135 | /* Keymap mapping ASCII function key sequences onto their preferred | 144 | /* Keymap mapping ASCII function key sequences onto their preferred |
| 136 | forms. Initialized by the terminal-specific lisp files. See the | 145 | forms. Initialized by the terminal-specific lisp files. See the |
| 137 | DEFVAR for more documentation. */ | 146 | DEFVAR for more documentation. */ |
| 138 | Lisp_Object Vinput_decode_map; | 147 | Lisp_Object KBOARD_INTERNAL_FIELD (Vinput_decode_map); |
| 139 | 148 | ||
| 140 | /* Minibufferless frames on this display use this frame's minibuffer. */ | 149 | /* Minibufferless frames on this display use this frame's minibuffer. */ |
| 141 | Lisp_Object Vdefault_minibuffer_frame; | 150 | Lisp_Object KBOARD_INTERNAL_FIELD (Vdefault_minibuffer_frame); |
| 142 | 151 | ||
| 143 | /* Number of displays using this KBOARD. Normally 1, but can be | 152 | /* Number of displays using this KBOARD. Normally 1, but can be |
| 144 | larger when you have multiple screens on a single X display. */ | 153 | larger when you have multiple screens on a single X display. */ |
| @@ -146,7 +155,7 @@ struct kboard | |||
| 146 | 155 | ||
| 147 | /* The text we're echoing in the modeline - partial key sequences, | 156 | /* The text we're echoing in the modeline - partial key sequences, |
| 148 | usually. This is nil when not echoing. */ | 157 | usually. This is nil when not echoing. */ |
| 149 | Lisp_Object echo_string; | 158 | Lisp_Object KBOARD_INTERNAL_FIELD (echo_string); |
| 150 | 159 | ||
| 151 | /* This flag indicates that events were put into kbd_queue | 160 | /* This flag indicates that events were put into kbd_queue |
| 152 | while Emacs was running for some other KBOARD. | 161 | while Emacs was running for some other KBOARD. |
diff --git a/src/keymap.c b/src/keymap.c index b694deadcba..0e4715e4b8b 100644 --- a/src/keymap.c +++ b/src/keymap.c | |||
| @@ -1565,8 +1565,8 @@ like in the respective argument of `key-binding'. */) | |||
| 1565 | 1565 | ||
| 1566 | if (!NILP (olp)) | 1566 | if (!NILP (olp)) |
| 1567 | { | 1567 | { |
| 1568 | if (!NILP (current_kboard->Voverriding_terminal_local_map)) | 1568 | if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) |
| 1569 | keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps); | 1569 | keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps); |
| 1570 | /* The doc said that overriding-terminal-local-map should | 1570 | /* The doc said that overriding-terminal-local-map should |
| 1571 | override overriding-local-map. The code used them both, | 1571 | override overriding-local-map. The code used them both, |
| 1572 | but it seems clearer to use just one. rms, jan 2005. */ | 1572 | but it seems clearer to use just one. rms, jan 2005. */ |
| @@ -1745,9 +1745,9 @@ specified buffer position instead of point are used. | |||
| 1745 | } | 1745 | } |
| 1746 | } | 1746 | } |
| 1747 | 1747 | ||
| 1748 | if (! NILP (current_kboard->Voverriding_terminal_local_map)) | 1748 | if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) |
| 1749 | { | 1749 | { |
| 1750 | value = Flookup_key (current_kboard->Voverriding_terminal_local_map, | 1750 | value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map), |
| 1751 | key, accept_default); | 1751 | key, accept_default); |
| 1752 | if (! NILP (value) && !INTEGERP (value)) | 1752 | if (! NILP (value) && !INTEGERP (value)) |
| 1753 | goto done; | 1753 | goto done; |
| @@ -1883,7 +1883,7 @@ bindings; see the description of `lookup-key' for more details about this. */) | |||
| 1883 | (Lisp_Object keys, Lisp_Object accept_default) | 1883 | (Lisp_Object keys, Lisp_Object accept_default) |
| 1884 | { | 1884 | { |
| 1885 | register Lisp_Object map; | 1885 | register Lisp_Object map; |
| 1886 | map = B_ (current_buffer, keymap); | 1886 | map = BVAR (current_buffer, keymap); |
| 1887 | if (NILP (map)) | 1887 | if (NILP (map)) |
| 1888 | return Qnil; | 1888 | return Qnil; |
| 1889 | return Flookup_key (map, keys, accept_default); | 1889 | return Flookup_key (map, keys, accept_default); |
| @@ -1988,7 +1988,7 @@ If KEYMAP is nil, that means no local keymap. */) | |||
| 1988 | if (!NILP (keymap)) | 1988 | if (!NILP (keymap)) |
| 1989 | keymap = get_keymap (keymap, 1, 1); | 1989 | keymap = get_keymap (keymap, 1, 1); |
| 1990 | 1990 | ||
| 1991 | B_ (current_buffer, keymap) = keymap; | 1991 | BVAR (current_buffer, keymap) = keymap; |
| 1992 | 1992 | ||
| 1993 | return Qnil; | 1993 | return Qnil; |
| 1994 | } | 1994 | } |
| @@ -1998,7 +1998,7 @@ DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, | |||
| 1998 | Normally the local keymap is set by the major mode with `use-local-map'. */) | 1998 | Normally the local keymap is set by the major mode with `use-local-map'. */) |
| 1999 | (void) | 1999 | (void) |
| 2000 | { | 2000 | { |
| 2001 | return B_ (current_buffer, keymap); | 2001 | return BVAR (current_buffer, keymap); |
| 2002 | } | 2002 | } |
| 2003 | 2003 | ||
| 2004 | DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, | 2004 | 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 | |||
| 2379 | *p++ = 'C'; | 2379 | *p++ = 'C'; |
| 2380 | } | 2380 | } |
| 2381 | else if (c < 128 | 2381 | else if (c < 128 |
| 2382 | || (NILP (B_ (current_buffer, enable_multibyte_characters)) | 2382 | || (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 2383 | && SINGLE_BYTE_CHAR_P (c) | 2383 | && SINGLE_BYTE_CHAR_P (c) |
| 2384 | && !force_multibyte)) | 2384 | && !force_multibyte)) |
| 2385 | { | 2385 | { |
| @@ -2388,7 +2388,7 @@ push_key_description (register unsigned int c, register char *p, int force_multi | |||
| 2388 | else | 2388 | else |
| 2389 | { | 2389 | { |
| 2390 | /* Now we are sure that C is a valid character code. */ | 2390 | /* Now we are sure that C is a valid character code. */ |
| 2391 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 2391 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 2392 | && ! force_multibyte) | 2392 | && ! force_multibyte) |
| 2393 | *p++ = multibyte_char_to_unibyte (c, Qnil); | 2393 | *p++ = multibyte_char_to_unibyte (c, Qnil); |
| 2394 | else | 2394 | else |
| @@ -2941,11 +2941,11 @@ You type Translation\n\ | |||
| 2941 | outbuf = Fcurrent_buffer (); | 2941 | outbuf = Fcurrent_buffer (); |
| 2942 | 2942 | ||
| 2943 | /* Report on alternates for keys. */ | 2943 | /* Report on alternates for keys. */ |
| 2944 | if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix)) | 2944 | if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix)) |
| 2945 | { | 2945 | { |
| 2946 | int c; | 2946 | int c; |
| 2947 | const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table); | 2947 | const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); |
| 2948 | int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table); | 2948 | int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)); |
| 2949 | 2949 | ||
| 2950 | for (c = 0; c < translate_len; c++) | 2950 | for (c = 0; c < translate_len; c++) |
| 2951 | if (translate[c] != c) | 2951 | if (translate[c] != c) |
| @@ -2968,7 +2968,7 @@ You type Translation\n\ | |||
| 2968 | insert ("\n", 1); | 2968 | insert ("\n", 1); |
| 2969 | 2969 | ||
| 2970 | /* Insert calls signal_after_change which may GC. */ | 2970 | /* Insert calls signal_after_change which may GC. */ |
| 2971 | translate = SDATA (current_kboard->Vkeyboard_translate_table); | 2971 | translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); |
| 2972 | } | 2972 | } |
| 2973 | 2973 | ||
| 2974 | insert ("\n", 1); | 2974 | insert ("\n", 1); |
| @@ -2981,8 +2981,8 @@ You type Translation\n\ | |||
| 2981 | 2981 | ||
| 2982 | /* Print the (major mode) local map. */ | 2982 | /* Print the (major mode) local map. */ |
| 2983 | start1 = Qnil; | 2983 | start1 = Qnil; |
| 2984 | if (!NILP (current_kboard->Voverriding_terminal_local_map)) | 2984 | if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) |
| 2985 | start1 = current_kboard->Voverriding_terminal_local_map; | 2985 | start1 = KVAR (current_kboard, Voverriding_terminal_local_map); |
| 2986 | else if (!NILP (Voverriding_local_map)) | 2986 | else if (!NILP (Voverriding_local_map)) |
| 2987 | start1 = Voverriding_local_map; | 2987 | start1 = Voverriding_local_map; |
| 2988 | 2988 | ||
| @@ -3048,7 +3048,7 @@ You type Translation\n\ | |||
| 3048 | XBUFFER (buffer), Qlocal_map); | 3048 | XBUFFER (buffer), Qlocal_map); |
| 3049 | if (!NILP (start1)) | 3049 | if (!NILP (start1)) |
| 3050 | { | 3050 | { |
| 3051 | if (EQ (start1, B_ (XBUFFER (buffer), keymap))) | 3051 | if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) |
| 3052 | describe_map_tree (start1, 1, shadow, prefix, | 3052 | describe_map_tree (start1, 1, shadow, prefix, |
| 3053 | "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); | 3053 | "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); |
| 3054 | else | 3054 | else |
| @@ -3064,13 +3064,13 @@ You type Translation\n\ | |||
| 3064 | "\f\nGlobal Bindings", nomenu, 0, 1, 0); | 3064 | "\f\nGlobal Bindings", nomenu, 0, 1, 0); |
| 3065 | 3065 | ||
| 3066 | /* Print the function-key-map translations under this prefix. */ | 3066 | /* Print the function-key-map translations under this prefix. */ |
| 3067 | if (!NILP (current_kboard->Vlocal_function_key_map)) | 3067 | if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) |
| 3068 | describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix, | 3068 | describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix, |
| 3069 | "\f\nFunction key map translations", nomenu, 1, 0, 0); | 3069 | "\f\nFunction key map translations", nomenu, 1, 0, 0); |
| 3070 | 3070 | ||
| 3071 | /* Print the input-decode-map translations under this prefix. */ | 3071 | /* Print the input-decode-map translations under this prefix. */ |
| 3072 | if (!NILP (current_kboard->Vinput_decode_map)) | 3072 | if (!NILP (KVAR (current_kboard, Vinput_decode_map))) |
| 3073 | describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix, | 3073 | describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix, |
| 3074 | "\f\nInput decoding map translations", nomenu, 1, 0, 0); | 3074 | "\f\nInput decoding map translations", nomenu, 1, 0, 0); |
| 3075 | 3075 | ||
| 3076 | UNGCPRO; | 3076 | UNGCPRO; |
diff --git a/src/lisp.h b/src/lisp.h index 0efadd675b0..82c4f65613d 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1882,7 +1882,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); | |||
| 1882 | #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \ | 1882 | #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \ |
| 1883 | do { \ | 1883 | do { \ |
| 1884 | static struct Lisp_Objfwd o_fwd; \ | 1884 | static struct Lisp_Objfwd o_fwd; \ |
| 1885 | defvar_lisp_nopro (&o_fwd, lname, &buffer_defaults.vname ## _); \ | 1885 | defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \ |
| 1886 | } while (0) | 1886 | } while (0) |
| 1887 | 1887 | ||
| 1888 | #define DEFVAR_KBOARD(lname, vname, doc) \ | 1888 | #define DEFVAR_KBOARD(lname, vname, doc) \ |
| @@ -1890,7 +1890,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); | |||
| 1890 | static struct Lisp_Kboard_Objfwd ko_fwd; \ | 1890 | static struct Lisp_Kboard_Objfwd ko_fwd; \ |
| 1891 | defvar_kboard (&ko_fwd, \ | 1891 | defvar_kboard (&ko_fwd, \ |
| 1892 | lname, \ | 1892 | lname, \ |
| 1893 | (int)((char *)(¤t_kboard->vname) \ | 1893 | (int)((char *)(¤t_kboard->vname ## _) \ |
| 1894 | - (char *)current_kboard)); \ | 1894 | - (char *)current_kboard)); \ |
| 1895 | } while (0) | 1895 | } while (0) |
| 1896 | 1896 | ||
| @@ -2047,11 +2047,11 @@ extern Lisp_Object case_temp2; | |||
| 2047 | 2047 | ||
| 2048 | /* Current buffer's map from characters to lower-case characters. */ | 2048 | /* Current buffer's map from characters to lower-case characters. */ |
| 2049 | 2049 | ||
| 2050 | #define DOWNCASE_TABLE B_ (current_buffer, downcase_table) | 2050 | #define DOWNCASE_TABLE BVAR (current_buffer, downcase_table) |
| 2051 | 2051 | ||
| 2052 | /* Current buffer's map from characters to upper-case characters. */ | 2052 | /* Current buffer's map from characters to upper-case characters. */ |
| 2053 | 2053 | ||
| 2054 | #define UPCASE_TABLE B_ (current_buffer, upcase_table) | 2054 | #define UPCASE_TABLE BVAR (current_buffer, upcase_table) |
| 2055 | 2055 | ||
| 2056 | /* Downcase a character, or make no change if that cannot be done. */ | 2056 | /* Downcase a character, or make no change if that cannot be done. */ |
| 2057 | 2057 | ||
| @@ -2145,6 +2145,11 @@ struct gcpro | |||
| 2145 | #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE | 2145 | #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE |
| 2146 | #endif | 2146 | #endif |
| 2147 | 2147 | ||
| 2148 | /* Whether we do the stack marking manually. */ | ||
| 2149 | #define BYTE_MARK_STACK !(GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ | ||
| 2150 | || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) | ||
| 2151 | |||
| 2152 | |||
| 2148 | #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS | 2153 | #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS |
| 2149 | 2154 | ||
| 2150 | /* Do something silly with gcproN vars just so gcc shuts up. */ | 2155 | /* Do something silly with gcproN vars just so gcc shuts up. */ |
| @@ -3253,7 +3258,9 @@ extern Lisp_Object Qbytecode; | |||
| 3253 | EXFUN (Fbyte_code, 3); | 3258 | EXFUN (Fbyte_code, 3); |
| 3254 | extern void syms_of_bytecode (void); | 3259 | extern void syms_of_bytecode (void); |
| 3255 | extern struct byte_stack *byte_stack_list; | 3260 | extern struct byte_stack *byte_stack_list; |
| 3261 | #ifdef BYTE_MARK_STACK | ||
| 3256 | extern void mark_byte_stack (void); | 3262 | extern void mark_byte_stack (void); |
| 3263 | #endif | ||
| 3257 | extern void unmark_byte_stack (void); | 3264 | extern void unmark_byte_stack (void); |
| 3258 | 3265 | ||
| 3259 | /* Defined in macros.c */ | 3266 | /* Defined in macros.c */ |
diff --git a/src/lread.c b/src/lread.c index de9c5db95ad..7e410fcc334 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -210,7 +210,7 @@ readchar (Lisp_Object readcharfun, int *multibyte) | |||
| 210 | if (pt_byte >= BUF_ZV_BYTE (inbuffer)) | 210 | if (pt_byte >= BUF_ZV_BYTE (inbuffer)) |
| 211 | return -1; | 211 | return -1; |
| 212 | 212 | ||
| 213 | if (! NILP (B_ (inbuffer, enable_multibyte_characters))) | 213 | if (! NILP (BVAR (inbuffer, enable_multibyte_characters))) |
| 214 | { | 214 | { |
| 215 | /* Fetch the character code from the buffer. */ | 215 | /* Fetch the character code from the buffer. */ |
| 216 | unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); | 216 | unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); |
| @@ -239,7 +239,7 @@ readchar (Lisp_Object readcharfun, int *multibyte) | |||
| 239 | if (bytepos >= BUF_ZV_BYTE (inbuffer)) | 239 | if (bytepos >= BUF_ZV_BYTE (inbuffer)) |
| 240 | return -1; | 240 | return -1; |
| 241 | 241 | ||
| 242 | if (! NILP (B_ (inbuffer, enable_multibyte_characters))) | 242 | if (! NILP (BVAR (inbuffer, enable_multibyte_characters))) |
| 243 | { | 243 | { |
| 244 | /* Fetch the character code from the buffer. */ | 244 | /* Fetch the character code from the buffer. */ |
| 245 | unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); | 245 | unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); |
| @@ -371,7 +371,7 @@ unreadchar (Lisp_Object readcharfun, int c) | |||
| 371 | EMACS_INT bytepos = BUF_PT_BYTE (b); | 371 | EMACS_INT bytepos = BUF_PT_BYTE (b); |
| 372 | 372 | ||
| 373 | BUF_PT (b)--; | 373 | BUF_PT (b)--; |
| 374 | if (! NILP (B_ (b, enable_multibyte_characters))) | 374 | if (! NILP (BVAR (b, enable_multibyte_characters))) |
| 375 | BUF_DEC_POS (b, bytepos); | 375 | BUF_DEC_POS (b, bytepos); |
| 376 | else | 376 | else |
| 377 | bytepos--; | 377 | bytepos--; |
| @@ -384,7 +384,7 @@ unreadchar (Lisp_Object readcharfun, int c) | |||
| 384 | EMACS_INT bytepos = XMARKER (readcharfun)->bytepos; | 384 | EMACS_INT bytepos = XMARKER (readcharfun)->bytepos; |
| 385 | 385 | ||
| 386 | XMARKER (readcharfun)->charpos--; | 386 | XMARKER (readcharfun)->charpos--; |
| 387 | if (! NILP (B_ (b, enable_multibyte_characters))) | 387 | if (! NILP (BVAR (b, enable_multibyte_characters))) |
| 388 | BUF_DEC_POS (b, bytepos); | 388 | BUF_DEC_POS (b, bytepos); |
| 389 | else | 389 | else |
| 390 | bytepos--; | 390 | bytepos--; |
| @@ -1322,7 +1322,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto | |||
| 1322 | /* Of course, this could conceivably lose if luser sets | 1322 | /* Of course, this could conceivably lose if luser sets |
| 1323 | default-directory to be something non-absolute... */ | 1323 | default-directory to be something non-absolute... */ |
| 1324 | { | 1324 | { |
| 1325 | filename = Fexpand_file_name (filename, B_ (current_buffer, directory)); | 1325 | filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); |
| 1326 | if (!complete_filename_p (filename)) | 1326 | if (!complete_filename_p (filename)) |
| 1327 | /* Give up on this path element! */ | 1327 | /* Give up on this path element! */ |
| 1328 | continue; | 1328 | continue; |
| @@ -1581,7 +1581,7 @@ readevalloop (Lisp_Object readcharfun, | |||
| 1581 | { | 1581 | { |
| 1582 | int count1 = SPECPDL_INDEX (); | 1582 | int count1 = SPECPDL_INDEX (); |
| 1583 | 1583 | ||
| 1584 | if (b != 0 && NILP (B_ (b, name))) | 1584 | if (b != 0 && NILP (BVAR (b, name))) |
| 1585 | error ("Reading from killed buffer"); | 1585 | error ("Reading from killed buffer"); |
| 1586 | 1586 | ||
| 1587 | if (!NILP (start)) | 1587 | if (!NILP (start)) |
| @@ -1721,7 +1721,7 @@ This function preserves the position of point. */) | |||
| 1721 | tem = printflag; | 1721 | tem = printflag; |
| 1722 | 1722 | ||
| 1723 | if (NILP (filename)) | 1723 | if (NILP (filename)) |
| 1724 | filename = B_ (XBUFFER (buf), filename); | 1724 | filename = BVAR (XBUFFER (buf), filename); |
| 1725 | 1725 | ||
| 1726 | specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); | 1726 | specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); |
| 1727 | specbind (Qstandard_output, tem); | 1727 | specbind (Qstandard_output, tem); |
| @@ -1761,7 +1761,7 @@ This function does not move point. */) | |||
| 1761 | specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); | 1761 | specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); |
| 1762 | 1762 | ||
| 1763 | /* readevalloop calls functions which check the type of start and end. */ | 1763 | /* readevalloop calls functions which check the type of start and end. */ |
| 1764 | readevalloop (cbuf, 0, B_ (XBUFFER (cbuf), filename), Feval, | 1764 | readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename), Feval, |
| 1765 | !NILP (printflag), Qnil, read_function, | 1765 | !NILP (printflag), Qnil, read_function, |
| 1766 | start, end); | 1766 | start, end); |
| 1767 | 1767 | ||
diff --git a/src/macros.c b/src/macros.c index 34ac08c3284..d90b31b503f 100644 --- a/src/macros.c +++ b/src/macros.c | |||
| @@ -56,7 +56,7 @@ If optional second arg, NO-EXEC, is non-nil, do not re-execute last | |||
| 56 | macro before appending to it. */) | 56 | macro before appending to it. */) |
| 57 | (Lisp_Object append, Lisp_Object no_exec) | 57 | (Lisp_Object append, Lisp_Object no_exec) |
| 58 | { | 58 | { |
| 59 | if (!NILP (current_kboard->defining_kbd_macro)) | 59 | if (!NILP (KVAR (current_kboard, defining_kbd_macro))) |
| 60 | error ("Already defining kbd macro"); | 60 | error ("Already defining kbd macro"); |
| 61 | 61 | ||
| 62 | if (!current_kboard->kbd_macro_buffer) | 62 | if (!current_kboard->kbd_macro_buffer) |
| @@ -85,9 +85,9 @@ macro before appending to it. */) | |||
| 85 | int cvt; | 85 | int cvt; |
| 86 | 86 | ||
| 87 | /* Check the type of last-kbd-macro in case Lisp code changed it. */ | 87 | /* Check the type of last-kbd-macro in case Lisp code changed it. */ |
| 88 | CHECK_VECTOR_OR_STRING (current_kboard->Vlast_kbd_macro); | 88 | CHECK_VECTOR_OR_STRING (KVAR (current_kboard, Vlast_kbd_macro)); |
| 89 | 89 | ||
| 90 | len = XINT (Flength (current_kboard->Vlast_kbd_macro)); | 90 | len = XINT (Flength (KVAR (current_kboard, Vlast_kbd_macro))); |
| 91 | 91 | ||
| 92 | /* Copy last-kbd-macro into the buffer, in case the Lisp code | 92 | /* Copy last-kbd-macro into the buffer, in case the Lisp code |
| 93 | has put another macro there. */ | 93 | has put another macro there. */ |
| @@ -100,11 +100,11 @@ macro before appending to it. */) | |||
| 100 | } | 100 | } |
| 101 | 101 | ||
| 102 | /* Must convert meta modifier when copying string to vector. */ | 102 | /* Must convert meta modifier when copying string to vector. */ |
| 103 | cvt = STRINGP (current_kboard->Vlast_kbd_macro); | 103 | cvt = STRINGP (KVAR (current_kboard, Vlast_kbd_macro)); |
| 104 | for (i = 0; i < len; i++) | 104 | for (i = 0; i < len; i++) |
| 105 | { | 105 | { |
| 106 | Lisp_Object c; | 106 | Lisp_Object c; |
| 107 | c = Faref (current_kboard->Vlast_kbd_macro, make_number (i)); | 107 | c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_number (i)); |
| 108 | if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80)) | 108 | if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80)) |
| 109 | XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); | 109 | XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); |
| 110 | current_kboard->kbd_macro_buffer[i] = c; | 110 | current_kboard->kbd_macro_buffer[i] = c; |
| @@ -116,12 +116,12 @@ macro before appending to it. */) | |||
| 116 | /* Re-execute the macro we are appending to, | 116 | /* Re-execute the macro we are appending to, |
| 117 | for consistency of behavior. */ | 117 | for consistency of behavior. */ |
| 118 | if (NILP (no_exec)) | 118 | if (NILP (no_exec)) |
| 119 | Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, | 119 | Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), |
| 120 | make_number (1), Qnil); | 120 | make_number (1), Qnil); |
| 121 | 121 | ||
| 122 | message ("Appending to kbd macro..."); | 122 | message ("Appending to kbd macro..."); |
| 123 | } | 123 | } |
| 124 | current_kboard->defining_kbd_macro = Qt; | 124 | KVAR (current_kboard, defining_kbd_macro) = Qt; |
| 125 | 125 | ||
| 126 | return Qnil; | 126 | return Qnil; |
| 127 | } | 127 | } |
| @@ -131,9 +131,9 @@ macro before appending to it. */) | |||
| 131 | void | 131 | void |
| 132 | end_kbd_macro (void) | 132 | end_kbd_macro (void) |
| 133 | { | 133 | { |
| 134 | current_kboard->defining_kbd_macro = Qnil; | 134 | KVAR (current_kboard, defining_kbd_macro) = Qnil; |
| 135 | update_mode_lines++; | 135 | update_mode_lines++; |
| 136 | current_kboard->Vlast_kbd_macro | 136 | KVAR (current_kboard, Vlast_kbd_macro) |
| 137 | = make_event_array ((current_kboard->kbd_macro_end | 137 | = make_event_array ((current_kboard->kbd_macro_end |
| 138 | - current_kboard->kbd_macro_buffer), | 138 | - current_kboard->kbd_macro_buffer), |
| 139 | current_kboard->kbd_macro_buffer); | 139 | current_kboard->kbd_macro_buffer); |
| @@ -154,7 +154,7 @@ In Lisp, optional second arg LOOPFUNC may be a function that is called prior to | |||
| 154 | each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) | 154 | each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) |
| 155 | (Lisp_Object repeat, Lisp_Object loopfunc) | 155 | (Lisp_Object repeat, Lisp_Object loopfunc) |
| 156 | { | 156 | { |
| 157 | if (NILP (current_kboard->defining_kbd_macro)) | 157 | if (NILP (KVAR (current_kboard, defining_kbd_macro))) |
| 158 | error ("Not defining kbd macro"); | 158 | error ("Not defining kbd macro"); |
| 159 | 159 | ||
| 160 | if (NILP (repeat)) | 160 | if (NILP (repeat)) |
| @@ -162,19 +162,19 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) | |||
| 162 | else | 162 | else |
| 163 | CHECK_NUMBER (repeat); | 163 | CHECK_NUMBER (repeat); |
| 164 | 164 | ||
| 165 | if (!NILP (current_kboard->defining_kbd_macro)) | 165 | if (!NILP (KVAR (current_kboard, defining_kbd_macro))) |
| 166 | { | 166 | { |
| 167 | end_kbd_macro (); | 167 | end_kbd_macro (); |
| 168 | message ("Keyboard macro defined"); | 168 | message ("Keyboard macro defined"); |
| 169 | } | 169 | } |
| 170 | 170 | ||
| 171 | if (XFASTINT (repeat) == 0) | 171 | if (XFASTINT (repeat) == 0) |
| 172 | Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc); | 172 | Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); |
| 173 | else | 173 | else |
| 174 | { | 174 | { |
| 175 | XSETINT (repeat, XINT (repeat)-1); | 175 | XSETINT (repeat, XINT (repeat)-1); |
| 176 | if (XINT (repeat) > 0) | 176 | if (XINT (repeat) > 0) |
| 177 | Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc); | 177 | Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); |
| 178 | } | 178 | } |
| 179 | return Qnil; | 179 | return Qnil; |
| 180 | } | 180 | } |
| @@ -186,7 +186,7 @@ store_kbd_macro_char (Lisp_Object c) | |||
| 186 | { | 186 | { |
| 187 | struct kboard *kb = current_kboard; | 187 | struct kboard *kb = current_kboard; |
| 188 | 188 | ||
| 189 | if (!NILP (kb->defining_kbd_macro)) | 189 | if (!NILP (KVAR (kb, defining_kbd_macro))) |
| 190 | { | 190 | { |
| 191 | if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize) | 191 | if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize) |
| 192 | { | 192 | { |
| @@ -248,21 +248,21 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) | |||
| 248 | { | 248 | { |
| 249 | /* Don't interfere with recognition of the previous command | 249 | /* Don't interfere with recognition of the previous command |
| 250 | from before this macro started. */ | 250 | from before this macro started. */ |
| 251 | Vthis_command = current_kboard->Vlast_command; | 251 | Vthis_command = KVAR (current_kboard, Vlast_command); |
| 252 | /* C-x z after the macro should repeat the macro. */ | 252 | /* C-x z after the macro should repeat the macro. */ |
| 253 | real_this_command = current_kboard->Vlast_kbd_macro; | 253 | real_this_command = KVAR (current_kboard, Vlast_kbd_macro); |
| 254 | 254 | ||
| 255 | if (! NILP (current_kboard->defining_kbd_macro)) | 255 | if (! NILP (KVAR (current_kboard, defining_kbd_macro))) |
| 256 | error ("Can't execute anonymous macro while defining one"); | 256 | error ("Can't execute anonymous macro while defining one"); |
| 257 | else if (NILP (current_kboard->Vlast_kbd_macro)) | 257 | else if (NILP (KVAR (current_kboard, Vlast_kbd_macro))) |
| 258 | error ("No kbd macro has been defined"); | 258 | error ("No kbd macro has been defined"); |
| 259 | else | 259 | else |
| 260 | Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix, loopfunc); | 260 | Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), prefix, loopfunc); |
| 261 | 261 | ||
| 262 | /* command_loop_1 sets this to nil before it returns; | 262 | /* command_loop_1 sets this to nil before it returns; |
| 263 | get back the last command within the macro | 263 | get back the last command within the macro |
| 264 | so that it can be last, again, after we return. */ | 264 | so that it can be last, again, after we return. */ |
| 265 | Vthis_command = current_kboard->Vlast_command; | 265 | Vthis_command = KVAR (current_kboard, Vlast_command); |
| 266 | 266 | ||
| 267 | return Qnil; | 267 | return Qnil; |
| 268 | } | 268 | } |
| @@ -322,7 +322,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) | |||
| 322 | executing_kbd_macro = final; | 322 | executing_kbd_macro = final; |
| 323 | executing_kbd_macro_index = 0; | 323 | executing_kbd_macro_index = 0; |
| 324 | 324 | ||
| 325 | current_kboard->Vprefix_arg = Qnil; | 325 | KVAR (current_kboard, Vprefix_arg) = Qnil; |
| 326 | 326 | ||
| 327 | if (!NILP (loopfunc)) | 327 | if (!NILP (loopfunc)) |
| 328 | { | 328 | { |
diff --git a/src/marker.c b/src/marker.c index 9b841835646..72c564f420f 100644 --- a/src/marker.c +++ b/src/marker.c | |||
| @@ -439,7 +439,7 @@ Returns nil if MARKER points into a dead buffer. */) | |||
| 439 | does not preserve the buffer from being GC'd (it's weak), so | 439 | does not preserve the buffer from being GC'd (it's weak), so |
| 440 | markers have to be unlinked from their buffer as soon as the buffer | 440 | markers have to be unlinked from their buffer as soon as the buffer |
| 441 | is killed. */ | 441 | is killed. */ |
| 442 | eassert (!NILP (B_ (XBUFFER (buf), name))); | 442 | eassert (!NILP (BVAR (XBUFFER (buf), name))); |
| 443 | return buf; | 443 | return buf; |
| 444 | } | 444 | } |
| 445 | return Qnil; | 445 | return Qnil; |
| @@ -488,7 +488,7 @@ Returns MARKER. */) | |||
| 488 | CHECK_BUFFER (buffer); | 488 | CHECK_BUFFER (buffer); |
| 489 | b = XBUFFER (buffer); | 489 | b = XBUFFER (buffer); |
| 490 | /* If buffer is dead, set marker to point nowhere. */ | 490 | /* If buffer is dead, set marker to point nowhere. */ |
| 491 | if (EQ (B_ (b, name), Qnil)) | 491 | if (EQ (BVAR (b, name), Qnil)) |
| 492 | { | 492 | { |
| 493 | unchain_marker (m); | 493 | unchain_marker (m); |
| 494 | return marker; | 494 | return marker; |
| @@ -563,7 +563,7 @@ set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer) | |||
| 563 | CHECK_BUFFER (buffer); | 563 | CHECK_BUFFER (buffer); |
| 564 | b = XBUFFER (buffer); | 564 | b = XBUFFER (buffer); |
| 565 | /* If buffer is dead, set marker to point nowhere. */ | 565 | /* If buffer is dead, set marker to point nowhere. */ |
| 566 | if (EQ (B_ (b, name), Qnil)) | 566 | if (EQ (BVAR (b, name), Qnil)) |
| 567 | { | 567 | { |
| 568 | unchain_marker (m); | 568 | unchain_marker (m); |
| 569 | return marker; | 569 | return marker; |
| @@ -628,7 +628,7 @@ set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMAC | |||
| 628 | CHECK_BUFFER (buffer); | 628 | CHECK_BUFFER (buffer); |
| 629 | b = XBUFFER (buffer); | 629 | b = XBUFFER (buffer); |
| 630 | /* If buffer is dead, set marker to point nowhere. */ | 630 | /* If buffer is dead, set marker to point nowhere. */ |
| 631 | if (EQ (B_ (b, name), Qnil)) | 631 | if (EQ (BVAR (b, name), Qnil)) |
| 632 | { | 632 | { |
| 633 | unchain_marker (m); | 633 | unchain_marker (m); |
| 634 | return marker; | 634 | return marker; |
| @@ -676,7 +676,7 @@ set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT ch | |||
| 676 | CHECK_BUFFER (buffer); | 676 | CHECK_BUFFER (buffer); |
| 677 | b = XBUFFER (buffer); | 677 | b = XBUFFER (buffer); |
| 678 | /* If buffer is dead, set marker to point nowhere. */ | 678 | /* If buffer is dead, set marker to point nowhere. */ |
| 679 | if (EQ (B_ (b, name), Qnil)) | 679 | if (EQ (BVAR (b, name), Qnil)) |
| 680 | { | 680 | { |
| 681 | unchain_marker (m); | 681 | unchain_marker (m); |
| 682 | return marker; | 682 | return marker; |
| @@ -731,7 +731,7 @@ unchain_marker (register struct Lisp_Marker *marker) | |||
| 731 | if (b == 0) | 731 | if (b == 0) |
| 732 | return; | 732 | return; |
| 733 | 733 | ||
| 734 | if (EQ (B_ (b, name), Qnil)) | 734 | if (EQ (BVAR (b, name), Qnil)) |
| 735 | abort (); | 735 | abort (); |
| 736 | 736 | ||
| 737 | marker->buffer = 0; | 737 | marker->buffer = 0; |
diff --git a/src/minibuf.c b/src/minibuf.c index 3ed8630c845..4b709bd9cbd 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -415,7 +415,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 415 | CHECK_STRING (initial); | 415 | CHECK_STRING (initial); |
| 416 | } | 416 | } |
| 417 | val = Qnil; | 417 | val = Qnil; |
| 418 | ambient_dir = B_ (current_buffer, directory); | 418 | ambient_dir = BVAR (current_buffer, directory); |
| 419 | input_method = Qnil; | 419 | input_method = Qnil; |
| 420 | enable_multibyte = Qnil; | 420 | enable_multibyte = Qnil; |
| 421 | 421 | ||
| @@ -525,7 +525,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 525 | /* `current-input-method' is buffer local. So, remember it in | 525 | /* `current-input-method' is buffer local. So, remember it in |
| 526 | INPUT_METHOD before changing the current buffer. */ | 526 | INPUT_METHOD before changing the current buffer. */ |
| 527 | input_method = Fsymbol_value (Qcurrent_input_method); | 527 | input_method = Fsymbol_value (Qcurrent_input_method); |
| 528 | enable_multibyte = B_ (current_buffer, enable_multibyte_characters); | 528 | enable_multibyte = BVAR (current_buffer, enable_multibyte_characters); |
| 529 | } | 529 | } |
| 530 | 530 | ||
| 531 | /* Switch to the minibuffer. */ | 531 | /* Switch to the minibuffer. */ |
| @@ -535,7 +535,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 535 | 535 | ||
| 536 | /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ | 536 | /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ |
| 537 | if (inherit_input_method) | 537 | if (inherit_input_method) |
| 538 | B_ (current_buffer, enable_multibyte_characters) = enable_multibyte; | 538 | BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte; |
| 539 | 539 | ||
| 540 | /* The current buffer's default directory is usually the right thing | 540 | /* The current buffer's default directory is usually the right thing |
| 541 | for our minibuffer here. However, if you're typing a command at | 541 | 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, | |||
| 546 | you think of something better to do? Find another buffer with a | 546 | you think of something better to do? Find another buffer with a |
| 547 | better directory, and use that one instead. */ | 547 | better directory, and use that one instead. */ |
| 548 | if (STRINGP (ambient_dir)) | 548 | if (STRINGP (ambient_dir)) |
| 549 | B_ (current_buffer, directory) = ambient_dir; | 549 | BVAR (current_buffer, directory) = ambient_dir; |
| 550 | else | 550 | else |
| 551 | { | 551 | { |
| 552 | Lisp_Object buf_list; | 552 | Lisp_Object buf_list; |
| @@ -558,9 +558,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 558 | Lisp_Object other_buf; | 558 | Lisp_Object other_buf; |
| 559 | 559 | ||
| 560 | other_buf = XCDR (XCAR (buf_list)); | 560 | other_buf = XCDR (XCAR (buf_list)); |
| 561 | if (STRINGP (B_ (XBUFFER (other_buf), directory))) | 561 | if (STRINGP (BVAR (XBUFFER (other_buf), directory))) |
| 562 | { | 562 | { |
| 563 | B_ (current_buffer, directory) = B_ (XBUFFER (other_buf), directory); | 563 | BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory); |
| 564 | break; | 564 | break; |
| 565 | } | 565 | } |
| 566 | } | 566 | } |
| @@ -603,7 +603,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 603 | specbind (Qinhibit_modification_hooks, Qt); | 603 | specbind (Qinhibit_modification_hooks, Qt); |
| 604 | Ferase_buffer (); | 604 | Ferase_buffer (); |
| 605 | 605 | ||
| 606 | if (!NILP (B_ (current_buffer, enable_multibyte_characters)) | 606 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 607 | && ! STRING_MULTIBYTE (minibuf_prompt)) | 607 | && ! STRING_MULTIBYTE (minibuf_prompt)) |
| 608 | minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); | 608 | minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); |
| 609 | 609 | ||
| @@ -633,7 +633,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 633 | } | 633 | } |
| 634 | 634 | ||
| 635 | clear_message (1, 1); | 635 | clear_message (1, 1); |
| 636 | B_ (current_buffer, keymap) = map; | 636 | BVAR (current_buffer, keymap) = map; |
| 637 | 637 | ||
| 638 | /* Turn on an input method stored in INPUT_METHOD if any. */ | 638 | /* Turn on an input method stored in INPUT_METHOD if any. */ |
| 639 | if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) | 639 | if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) |
| @@ -647,7 +647,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 647 | call1 (Vrun_hooks, Qminibuffer_setup_hook); | 647 | call1 (Vrun_hooks, Qminibuffer_setup_hook); |
| 648 | 648 | ||
| 649 | /* Don't allow the user to undo past this point. */ | 649 | /* Don't allow the user to undo past this point. */ |
| 650 | B_ (current_buffer, undo_list) = Qnil; | 650 | BVAR (current_buffer, undo_list) = Qnil; |
| 651 | 651 | ||
| 652 | recursive_edit_1 (); | 652 | recursive_edit_1 (); |
| 653 | 653 | ||
| @@ -764,7 +764,7 @@ get_minibuffer (int depth) | |||
| 764 | Vminibuffer_list = nconc2 (Vminibuffer_list, tail); | 764 | Vminibuffer_list = nconc2 (Vminibuffer_list, tail); |
| 765 | } | 765 | } |
| 766 | buf = Fcar (tail); | 766 | buf = Fcar (tail); |
| 767 | if (NILP (buf) || NILP (B_ (XBUFFER (buf), name))) | 767 | if (NILP (buf) || NILP (BVAR (XBUFFER (buf), name))) |
| 768 | { | 768 | { |
| 769 | sprintf (name, " *Minibuf-%d*", depth); | 769 | sprintf (name, " *Minibuf-%d*", depth); |
| 770 | buf = Fget_buffer_create (build_string (name)); | 770 | buf = Fget_buffer_create (build_string (name)); |
| @@ -1096,7 +1096,7 @@ function, instead of the usual behavior. */) | |||
| 1096 | int count = SPECPDL_INDEX (); | 1096 | int count = SPECPDL_INDEX (); |
| 1097 | 1097 | ||
| 1098 | if (BUFFERP (def)) | 1098 | if (BUFFERP (def)) |
| 1099 | def = B_ (XBUFFER (def), name); | 1099 | def = BVAR (XBUFFER (def), name); |
| 1100 | 1100 | ||
| 1101 | specbind (Qcompletion_ignore_case, | 1101 | specbind (Qcompletion_ignore_case, |
| 1102 | read_buffer_completion_ignore_case ? Qt : Qnil); | 1102 | read_buffer_completion_ignore_case ? Qt : Qnil); |
diff --git a/src/msdos.c b/src/msdos.c index d37200e700a..8f0f6776aaa 100644 --- a/src/msdos.c +++ b/src/msdos.c | |||
| @@ -1317,12 +1317,12 @@ IT_frame_up_to_date (struct frame *f) | |||
| 1317 | { | 1317 | { |
| 1318 | struct buffer *b = XBUFFER (sw->buffer); | 1318 | struct buffer *b = XBUFFER (sw->buffer); |
| 1319 | 1319 | ||
| 1320 | if (EQ (B_ (b,cursor_type), Qt)) | 1320 | if (EQ (BVAR (b,cursor_type), Qt)) |
| 1321 | new_cursor = frame_desired_cursor; | 1321 | new_cursor = frame_desired_cursor; |
| 1322 | else if (NILP (B_ (b, cursor_type))) /* nil means no cursor */ | 1322 | else if (NILP (BVAR (b, cursor_type))) /* nil means no cursor */ |
| 1323 | new_cursor = Fcons (Qbar, make_number (0)); | 1323 | new_cursor = Fcons (Qbar, make_number (0)); |
| 1324 | else | 1324 | else |
| 1325 | new_cursor = B_ (b, cursor_type); | 1325 | new_cursor = BVAR (b, cursor_type); |
| 1326 | } | 1326 | } |
| 1327 | 1327 | ||
| 1328 | IT_set_cursor_type (f, new_cursor); | 1328 | IT_set_cursor_type (f, new_cursor); |
| @@ -1793,7 +1793,7 @@ internal_terminal_init (void) | |||
| 1793 | } | 1793 | } |
| 1794 | 1794 | ||
| 1795 | tty = FRAME_TTY (sf); | 1795 | tty = FRAME_TTY (sf); |
| 1796 | current_kboard->Vwindow_system = Qpc; | 1796 | KVAR (current_kboard, Vwindow_system) = Qpc; |
| 1797 | sf->output_method = output_msdos_raw; | 1797 | sf->output_method = output_msdos_raw; |
| 1798 | if (init_needed) | 1798 | if (init_needed) |
| 1799 | { | 1799 | { |
diff --git a/src/nsfns.m b/src/nsfns.m index c480c834602..6a5adbd7bf3 100644 --- a/src/nsfns.m +++ b/src/nsfns.m | |||
| @@ -605,8 +605,8 @@ ns_set_name_as_filename (struct frame *f) | |||
| 605 | 605 | ||
| 606 | BLOCK_INPUT; | 606 | BLOCK_INPUT; |
| 607 | pool = [[NSAutoreleasePool alloc] init]; | 607 | pool = [[NSAutoreleasePool alloc] init]; |
| 608 | filename = B_ (XBUFFER (buf), filename); | 608 | filename = BVAR (XBUFFER (buf), filename); |
| 609 | name = B_ (XBUFFER (buf), name); | 609 | name = BVAR (XBUFFER (buf), name); |
| 610 | 610 | ||
| 611 | if (NILP (name)) | 611 | if (NILP (name)) |
| 612 | { | 612 | { |
| @@ -1329,9 +1329,9 @@ be shared by the new frame. */) | |||
| 1329 | } | 1329 | } |
| 1330 | 1330 | ||
| 1331 | if (FRAME_HAS_MINIBUF_P (f) | 1331 | if (FRAME_HAS_MINIBUF_P (f) |
| 1332 | && (!FRAMEP (kb->Vdefault_minibuffer_frame) | 1332 | && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) |
| 1333 | || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) | 1333 | || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) |
| 1334 | kb->Vdefault_minibuffer_frame = frame; | 1334 | KVAR (kb, Vdefault_minibuffer_frame) = frame; |
| 1335 | 1335 | ||
| 1336 | /* All remaining specified parameters, which have not been "used" | 1336 | /* All remaining specified parameters, which have not been "used" |
| 1337 | by x_get_arg and friends, now go in the misc. alist of the frame. */ | 1337 | by x_get_arg and friends, now go in the misc. alist of the frame. */ |
| @@ -1428,7 +1428,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) | |||
| 1428 | NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : | 1428 | NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : |
| 1429 | [NSString stringWithUTF8String: SDATA (prompt)]; | 1429 | [NSString stringWithUTF8String: SDATA (prompt)]; |
| 1430 | NSString *dirS = NILP (dir) || !STRINGP (dir) ? | 1430 | NSString *dirS = NILP (dir) || !STRINGP (dir) ? |
| 1431 | [NSString stringWithUTF8String: SDATA (B_ (current_buffer, directory))] : | 1431 | [NSString stringWithUTF8String: SDATA (BVAR (current_buffer, directory))] : |
| 1432 | [NSString stringWithUTF8String: SDATA (dir)]; | 1432 | [NSString stringWithUTF8String: SDATA (dir)]; |
| 1433 | NSString *initS = NILP (init) || !STRINGP (init) ? nil : | 1433 | NSString *initS = NILP (init) || !STRINGP (init) ? nil : |
| 1434 | [NSString stringWithUTF8String: SDATA (init)]; | 1434 | [NSString stringWithUTF8String: SDATA (init)]; |
diff --git a/src/nsterm.m b/src/nsterm.m index 590a76ba16d..a09c95c7d01 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -3762,7 +3762,7 @@ ns_term_init (Lisp_Object display_name) | |||
| 3762 | 3762 | ||
| 3763 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); | 3763 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); |
| 3764 | init_kboard (terminal->kboard); | 3764 | init_kboard (terminal->kboard); |
| 3765 | terminal->kboard->Vwindow_system = Qns; | 3765 | KVAR (terminal->kboard, Vwindow_system) = Qns; |
| 3766 | terminal->kboard->next_kboard = all_kboards; | 3766 | terminal->kboard->next_kboard = all_kboards; |
| 3767 | all_kboards = terminal->kboard; | 3767 | all_kboards = terminal->kboard; |
| 3768 | /* Don't let the initial kboard remain current longer than necessary. | 3768 | /* Don't let the initial kboard remain current longer than necessary. |
diff --git a/src/print.c b/src/print.c index beb14a8b679..299cfd41814 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -111,7 +111,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; | |||
| 111 | EMACS_INT old_point_byte = -1, start_point_byte = -1; \ | 111 | EMACS_INT old_point_byte = -1, start_point_byte = -1; \ |
| 112 | int specpdl_count = SPECPDL_INDEX (); \ | 112 | int specpdl_count = SPECPDL_INDEX (); \ |
| 113 | int free_print_buffer = 0; \ | 113 | int free_print_buffer = 0; \ |
| 114 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); \ | 114 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ |
| 115 | Lisp_Object original | 115 | Lisp_Object original |
| 116 | 116 | ||
| 117 | #define PRINTPREPARE \ | 117 | #define PRINTPREPARE \ |
| @@ -144,10 +144,10 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; | |||
| 144 | if (NILP (printcharfun)) \ | 144 | if (NILP (printcharfun)) \ |
| 145 | { \ | 145 | { \ |
| 146 | Lisp_Object string; \ | 146 | Lisp_Object string; \ |
| 147 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) \ | 147 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \ |
| 148 | && ! print_escape_multibyte) \ | 148 | && ! print_escape_multibyte) \ |
| 149 | specbind (Qprint_escape_multibyte, Qt); \ | 149 | specbind (Qprint_escape_multibyte, Qt); \ |
| 150 | if (! NILP (B_ (current_buffer, enable_multibyte_characters)) \ | 150 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \ |
| 151 | && ! print_escape_nonascii) \ | 151 | && ! print_escape_nonascii) \ |
| 152 | specbind (Qprint_escape_nonascii, Qt); \ | 152 | specbind (Qprint_escape_nonascii, Qt); \ |
| 153 | if (print_buffer != 0) \ | 153 | if (print_buffer != 0) \ |
| @@ -173,7 +173,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; | |||
| 173 | if (NILP (printcharfun)) \ | 173 | if (NILP (printcharfun)) \ |
| 174 | { \ | 174 | { \ |
| 175 | if (print_buffer_pos != print_buffer_pos_byte \ | 175 | if (print_buffer_pos != print_buffer_pos_byte \ |
| 176 | && NILP (B_ (current_buffer, enable_multibyte_characters))) \ | 176 | && NILP (BVAR (current_buffer, enable_multibyte_characters))) \ |
| 177 | { \ | 177 | { \ |
| 178 | unsigned char *temp \ | 178 | unsigned char *temp \ |
| 179 | = (unsigned char *) alloca (print_buffer_pos + 1); \ | 179 | = (unsigned char *) alloca (print_buffer_pos + 1); \ |
| @@ -250,7 +250,7 @@ printchar (unsigned int ch, Lisp_Object fun) | |||
| 250 | else | 250 | else |
| 251 | { | 251 | { |
| 252 | int multibyte_p | 252 | int multibyte_p |
| 253 | = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 253 | = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 254 | 254 | ||
| 255 | setup_echo_area_for_printing (multibyte_p); | 255 | setup_echo_area_for_printing (multibyte_p); |
| 256 | insert_char (ch); | 256 | insert_char (ch); |
| @@ -302,7 +302,7 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, | |||
| 302 | job. */ | 302 | job. */ |
| 303 | int i; | 303 | int i; |
| 304 | int multibyte_p | 304 | int multibyte_p |
| 305 | = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 305 | = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 306 | 306 | ||
| 307 | setup_echo_area_for_printing (multibyte_p); | 307 | setup_echo_area_for_printing (multibyte_p); |
| 308 | message_dolog (ptr, size_byte, 0, multibyte_p); | 308 | message_dolog (ptr, size_byte, 0, multibyte_p); |
| @@ -371,8 +371,8 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) | |||
| 371 | chars = SCHARS (string); | 371 | chars = SCHARS (string); |
| 372 | else if (! print_escape_nonascii | 372 | else if (! print_escape_nonascii |
| 373 | && (EQ (printcharfun, Qt) | 373 | && (EQ (printcharfun, Qt) |
| 374 | ? ! NILP (B_ (&buffer_defaults, enable_multibyte_characters)) | 374 | ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)) |
| 375 | : ! NILP (B_ (current_buffer, enable_multibyte_characters)))) | 375 | : ! NILP (BVAR (current_buffer, enable_multibyte_characters)))) |
| 376 | { | 376 | { |
| 377 | /* If unibyte string STRING contains 8-bit codes, we must | 377 | /* If unibyte string STRING contains 8-bit codes, we must |
| 378 | convert STRING to a multibyte string containing the same | 378 | convert STRING to a multibyte string containing the same |
| @@ -504,14 +504,14 @@ temp_output_buffer_setup (const char *bufname) | |||
| 504 | 504 | ||
| 505 | Fkill_all_local_variables (); | 505 | Fkill_all_local_variables (); |
| 506 | delete_all_overlays (current_buffer); | 506 | delete_all_overlays (current_buffer); |
| 507 | B_ (current_buffer, directory) = B_ (old, directory); | 507 | BVAR (current_buffer, directory) = BVAR (old, directory); |
| 508 | B_ (current_buffer, read_only) = Qnil; | 508 | BVAR (current_buffer, read_only) = Qnil; |
| 509 | B_ (current_buffer, filename) = Qnil; | 509 | BVAR (current_buffer, filename) = Qnil; |
| 510 | B_ (current_buffer, undo_list) = Qt; | 510 | BVAR (current_buffer, undo_list) = Qt; |
| 511 | eassert (current_buffer->overlays_before == NULL); | 511 | eassert (current_buffer->overlays_before == NULL); |
| 512 | eassert (current_buffer->overlays_after == NULL); | 512 | eassert (current_buffer->overlays_after == NULL); |
| 513 | B_ (current_buffer, enable_multibyte_characters) | 513 | BVAR (current_buffer, enable_multibyte_characters) |
| 514 | = B_ (&buffer_defaults, enable_multibyte_characters); | 514 | = BVAR (&buffer_defaults, enable_multibyte_characters); |
| 515 | specbind (Qinhibit_read_only, Qt); | 515 | specbind (Qinhibit_read_only, Qt); |
| 516 | specbind (Qinhibit_modification_hooks, Qt); | 516 | specbind (Qinhibit_modification_hooks, Qt); |
| 517 | Ferase_buffer (); | 517 | Ferase_buffer (); |
| @@ -1856,7 +1856,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1856 | if (!NILP (XWINDOW (obj)->buffer)) | 1856 | if (!NILP (XWINDOW (obj)->buffer)) |
| 1857 | { | 1857 | { |
| 1858 | strout (" on ", -1, -1, printcharfun, 0); | 1858 | strout (" on ", -1, -1, printcharfun, 0); |
| 1859 | print_string (B_ (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); | 1859 | print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); |
| 1860 | } | 1860 | } |
| 1861 | PRINTCHAR ('>'); | 1861 | PRINTCHAR ('>'); |
| 1862 | } | 1862 | } |
| @@ -1957,16 +1957,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1957 | } | 1957 | } |
| 1958 | else if (BUFFERP (obj)) | 1958 | else if (BUFFERP (obj)) |
| 1959 | { | 1959 | { |
| 1960 | if (NILP (B_ (XBUFFER (obj), name))) | 1960 | if (NILP (BVAR (XBUFFER (obj), name))) |
| 1961 | strout ("#<killed buffer>", -1, -1, printcharfun, 0); | 1961 | strout ("#<killed buffer>", -1, -1, printcharfun, 0); |
| 1962 | else if (escapeflag) | 1962 | else if (escapeflag) |
| 1963 | { | 1963 | { |
| 1964 | strout ("#<buffer ", -1, -1, printcharfun, 0); | 1964 | strout ("#<buffer ", -1, -1, printcharfun, 0); |
| 1965 | print_string (B_ (XBUFFER (obj), name), printcharfun); | 1965 | print_string (BVAR (XBUFFER (obj), name), printcharfun); |
| 1966 | PRINTCHAR ('>'); | 1966 | PRINTCHAR ('>'); |
| 1967 | } | 1967 | } |
| 1968 | else | 1968 | else |
| 1969 | print_string (B_ (XBUFFER (obj), name), printcharfun); | 1969 | print_string (BVAR (XBUFFER (obj), name), printcharfun); |
| 1970 | } | 1970 | } |
| 1971 | else if (WINDOW_CONFIGURATIONP (obj)) | 1971 | else if (WINDOW_CONFIGURATIONP (obj)) |
| 1972 | { | 1972 | { |
| @@ -2078,7 +2078,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 2078 | sprintf (buf, "at %ld", (long)marker_position (obj)); | 2078 | sprintf (buf, "at %ld", (long)marker_position (obj)); |
| 2079 | strout (buf, -1, -1, printcharfun, 0); | 2079 | strout (buf, -1, -1, printcharfun, 0); |
| 2080 | strout (" in ", -1, -1, printcharfun, 0); | 2080 | strout (" in ", -1, -1, printcharfun, 0); |
| 2081 | print_string (B_ (XMARKER (obj)->buffer, name), printcharfun); | 2081 | print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); |
| 2082 | } | 2082 | } |
| 2083 | PRINTCHAR ('>'); | 2083 | PRINTCHAR ('>'); |
| 2084 | break; | 2084 | break; |
| @@ -2093,7 +2093,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 2093 | (long)marker_position (OVERLAY_START (obj)), | 2093 | (long)marker_position (OVERLAY_START (obj)), |
| 2094 | (long)marker_position (OVERLAY_END (obj))); | 2094 | (long)marker_position (OVERLAY_END (obj))); |
| 2095 | strout (buf, -1, -1, printcharfun, 0); | 2095 | strout (buf, -1, -1, printcharfun, 0); |
| 2096 | print_string (B_ (XMARKER (OVERLAY_START (obj))->buffer, name), | 2096 | print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), |
| 2097 | printcharfun); | 2097 | printcharfun); |
| 2098 | } | 2098 | } |
| 2099 | PRINTCHAR ('>'); | 2099 | PRINTCHAR ('>'); |
diff --git a/src/process.c b/src/process.c index ec929a919f8..4a145f7376a 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -719,7 +719,7 @@ get_process (register Lisp_Object name) | |||
| 719 | { | 719 | { |
| 720 | proc = Fget_buffer_process (obj); | 720 | proc = Fget_buffer_process (obj); |
| 721 | if (NILP (proc)) | 721 | if (NILP (proc)) |
| 722 | error ("Buffer %s has no process", SDATA (B_ (XBUFFER (obj), name))); | 722 | error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name))); |
| 723 | } | 723 | } |
| 724 | else | 724 | else |
| 725 | { | 725 | { |
| @@ -1283,12 +1283,12 @@ list_processes_1 (Lisp_Object query_only) | |||
| 1283 | w_proc = i; | 1283 | w_proc = i; |
| 1284 | if (!NILP (p->buffer)) | 1284 | if (!NILP (p->buffer)) |
| 1285 | { | 1285 | { |
| 1286 | if (NILP (B_ (XBUFFER (p->buffer), name))) | 1286 | if (NILP (BVAR (XBUFFER (p->buffer), name))) |
| 1287 | { | 1287 | { |
| 1288 | if (w_buffer < 8) | 1288 | if (w_buffer < 8) |
| 1289 | w_buffer = 8; /* (Killed) */ | 1289 | w_buffer = 8; /* (Killed) */ |
| 1290 | } | 1290 | } |
| 1291 | else if ((i = SCHARS (B_ (XBUFFER (p->buffer), name)), (i > w_buffer))) | 1291 | else if ((i = SCHARS (BVAR (XBUFFER (p->buffer), name)), (i > w_buffer))) |
| 1292 | w_buffer = i; | 1292 | w_buffer = i; |
| 1293 | } | 1293 | } |
| 1294 | if (STRINGP (p->tty_name) | 1294 | if (STRINGP (p->tty_name) |
| @@ -1312,9 +1312,9 @@ list_processes_1 (Lisp_Object query_only) | |||
| 1312 | XSETFASTINT (minspace, 1); | 1312 | XSETFASTINT (minspace, 1); |
| 1313 | 1313 | ||
| 1314 | set_buffer_internal (XBUFFER (Vstandard_output)); | 1314 | set_buffer_internal (XBUFFER (Vstandard_output)); |
| 1315 | B_ (current_buffer, undo_list) = Qt; | 1315 | BVAR (current_buffer, undo_list) = Qt; |
| 1316 | 1316 | ||
| 1317 | B_ (current_buffer, truncate_lines) = Qt; | 1317 | BVAR (current_buffer, truncate_lines) = Qt; |
| 1318 | 1318 | ||
| 1319 | write_string ("Proc", -1); | 1319 | write_string ("Proc", -1); |
| 1320 | Findent_to (i_status, minspace); write_string ("Status", -1); | 1320 | Findent_to (i_status, minspace); write_string ("Status", -1); |
| @@ -1397,10 +1397,10 @@ list_processes_1 (Lisp_Object query_only) | |||
| 1397 | Findent_to (i_buffer, minspace); | 1397 | Findent_to (i_buffer, minspace); |
| 1398 | if (NILP (p->buffer)) | 1398 | if (NILP (p->buffer)) |
| 1399 | insert_string ("(none)"); | 1399 | insert_string ("(none)"); |
| 1400 | else if (NILP (B_ (XBUFFER (p->buffer), name))) | 1400 | else if (NILP (BVAR (XBUFFER (p->buffer), name))) |
| 1401 | insert_string ("(Killed)"); | 1401 | insert_string ("(Killed)"); |
| 1402 | else | 1402 | else |
| 1403 | Finsert (1, &B_ (XBUFFER (p->buffer), name)); | 1403 | Finsert (1, &BVAR (XBUFFER (p->buffer), name)); |
| 1404 | 1404 | ||
| 1405 | if (!NILP (i_tty)) | 1405 | if (!NILP (i_tty)) |
| 1406 | { | 1406 | { |
| @@ -1548,7 +1548,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) | |||
| 1548 | { | 1548 | { |
| 1549 | struct gcpro gcpro1, gcpro2; | 1549 | struct gcpro gcpro1, gcpro2; |
| 1550 | 1550 | ||
| 1551 | current_dir = B_ (current_buffer, directory); | 1551 | current_dir = BVAR (current_buffer, directory); |
| 1552 | 1552 | ||
| 1553 | GCPRO2 (buffer, current_dir); | 1553 | GCPRO2 (buffer, current_dir); |
| 1554 | 1554 | ||
| @@ -1560,7 +1560,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) | |||
| 1560 | current_dir = expand_and_dir_to_file (current_dir, Qnil); | 1560 | current_dir = expand_and_dir_to_file (current_dir, Qnil); |
| 1561 | if (NILP (Ffile_accessible_directory_p (current_dir))) | 1561 | if (NILP (Ffile_accessible_directory_p (current_dir))) |
| 1562 | report_file_error ("Setting current directory", | 1562 | report_file_error ("Setting current directory", |
| 1563 | Fcons (B_ (current_buffer, directory), Qnil)); | 1563 | Fcons (BVAR (current_buffer, directory), Qnil)); |
| 1564 | 1564 | ||
| 1565 | UNGCPRO; | 1565 | UNGCPRO; |
| 1566 | } | 1566 | } |
| @@ -2898,8 +2898,8 @@ usage: (make-serial-process &rest ARGS) */) | |||
| 2898 | } | 2898 | } |
| 2899 | else if (!NILP (Vcoding_system_for_read)) | 2899 | else if (!NILP (Vcoding_system_for_read)) |
| 2900 | val = Vcoding_system_for_read; | 2900 | val = Vcoding_system_for_read; |
| 2901 | else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) | 2901 | else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) |
| 2902 | || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) | 2902 | || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) |
| 2903 | val = Qnil; | 2903 | val = Qnil; |
| 2904 | p->decode_coding_system = val; | 2904 | p->decode_coding_system = val; |
| 2905 | 2905 | ||
| @@ -2912,8 +2912,8 @@ usage: (make-serial-process &rest ARGS) */) | |||
| 2912 | } | 2912 | } |
| 2913 | else if (!NILP (Vcoding_system_for_write)) | 2913 | else if (!NILP (Vcoding_system_for_write)) |
| 2914 | val = Vcoding_system_for_write; | 2914 | val = Vcoding_system_for_write; |
| 2915 | else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) | 2915 | else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) |
| 2916 | || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) | 2916 | || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) |
| 2917 | val = Qnil; | 2917 | val = Qnil; |
| 2918 | p->encode_coding_system = val; | 2918 | p->encode_coding_system = val; |
| 2919 | 2919 | ||
| @@ -3723,8 +3723,8 @@ usage: (make-network-process &rest ARGS) */) | |||
| 3723 | } | 3723 | } |
| 3724 | else if (!NILP (Vcoding_system_for_read)) | 3724 | else if (!NILP (Vcoding_system_for_read)) |
| 3725 | val = Vcoding_system_for_read; | 3725 | val = Vcoding_system_for_read; |
| 3726 | else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) | 3726 | else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) |
| 3727 | || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) | 3727 | || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) |
| 3728 | /* We dare not decode end-of-line format by setting VAL to | 3728 | /* We dare not decode end-of-line format by setting VAL to |
| 3729 | Qraw_text, because the existing Emacs Lisp libraries | 3729 | Qraw_text, because the existing Emacs Lisp libraries |
| 3730 | assume that they receive bare code including a sequene of | 3730 | assume that they receive bare code including a sequene of |
| @@ -3759,7 +3759,7 @@ usage: (make-network-process &rest ARGS) */) | |||
| 3759 | } | 3759 | } |
| 3760 | else if (!NILP (Vcoding_system_for_write)) | 3760 | else if (!NILP (Vcoding_system_for_write)) |
| 3761 | val = Vcoding_system_for_write; | 3761 | val = Vcoding_system_for_write; |
| 3762 | else if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 3762 | else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 3763 | val = Qnil; | 3763 | val = Qnil; |
| 3764 | else | 3764 | else |
| 3765 | { | 3765 | { |
| @@ -5268,7 +5268,7 @@ read_process_output (Lisp_Object proc, register int channel) | |||
| 5268 | /* No need to gcpro these, because all we do with them later | 5268 | /* No need to gcpro these, because all we do with them later |
| 5269 | is test them for EQness, and none of them should be a string. */ | 5269 | is test them for EQness, and none of them should be a string. */ |
| 5270 | XSETBUFFER (obuffer, current_buffer); | 5270 | XSETBUFFER (obuffer, current_buffer); |
| 5271 | okeymap = B_ (current_buffer, keymap); | 5271 | okeymap = BVAR (current_buffer, keymap); |
| 5272 | 5272 | ||
| 5273 | /* We inhibit quit here instead of just catching it so that | 5273 | /* We inhibit quit here instead of just catching it so that |
| 5274 | hitting ^G when a filter happens to be running won't screw | 5274 | 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) | |||
| 5359 | } | 5359 | } |
| 5360 | 5360 | ||
| 5361 | /* If no filter, write into buffer if it isn't dead. */ | 5361 | /* If no filter, write into buffer if it isn't dead. */ |
| 5362 | else if (!NILP (p->buffer) && !NILP (B_ (XBUFFER (p->buffer), name))) | 5362 | else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name))) |
| 5363 | { | 5363 | { |
| 5364 | Lisp_Object old_read_only; | 5364 | Lisp_Object old_read_only; |
| 5365 | EMACS_INT old_begv, old_zv; | 5365 | EMACS_INT old_begv, old_zv; |
| @@ -5372,13 +5372,13 @@ read_process_output (Lisp_Object proc, register int channel) | |||
| 5372 | Fset_buffer (p->buffer); | 5372 | Fset_buffer (p->buffer); |
| 5373 | opoint = PT; | 5373 | opoint = PT; |
| 5374 | opoint_byte = PT_BYTE; | 5374 | opoint_byte = PT_BYTE; |
| 5375 | old_read_only = B_ (current_buffer, read_only); | 5375 | old_read_only = BVAR (current_buffer, read_only); |
| 5376 | old_begv = BEGV; | 5376 | old_begv = BEGV; |
| 5377 | old_zv = ZV; | 5377 | old_zv = ZV; |
| 5378 | old_begv_byte = BEGV_BYTE; | 5378 | old_begv_byte = BEGV_BYTE; |
| 5379 | old_zv_byte = ZV_BYTE; | 5379 | old_zv_byte = ZV_BYTE; |
| 5380 | 5380 | ||
| 5381 | B_ (current_buffer, read_only) = Qnil; | 5381 | BVAR (current_buffer, read_only) = Qnil; |
| 5382 | 5382 | ||
| 5383 | /* Insert new output into buffer | 5383 | /* Insert new output into buffer |
| 5384 | at the current end-of-output marker, | 5384 | at the current end-of-output marker, |
| @@ -5423,7 +5423,7 @@ read_process_output (Lisp_Object proc, register int channel) | |||
| 5423 | p->decoding_carryover = coding->carryover_bytes; | 5423 | p->decoding_carryover = coding->carryover_bytes; |
| 5424 | } | 5424 | } |
| 5425 | /* Adjust the multibyteness of TEXT to that of the buffer. */ | 5425 | /* Adjust the multibyteness of TEXT to that of the buffer. */ |
| 5426 | if (NILP (B_ (current_buffer, enable_multibyte_characters)) | 5426 | if (NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 5427 | != ! STRING_MULTIBYTE (text)) | 5427 | != ! STRING_MULTIBYTE (text)) |
| 5428 | text = (STRING_MULTIBYTE (text) | 5428 | text = (STRING_MULTIBYTE (text) |
| 5429 | ? Fstring_as_unibyte (text) | 5429 | ? Fstring_as_unibyte (text) |
| @@ -5467,7 +5467,7 @@ read_process_output (Lisp_Object proc, register int channel) | |||
| 5467 | Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); | 5467 | Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); |
| 5468 | 5468 | ||
| 5469 | 5469 | ||
| 5470 | B_ (current_buffer, read_only) = old_read_only; | 5470 | BVAR (current_buffer, read_only) = old_read_only; |
| 5471 | SET_PT_BOTH (opoint, opoint_byte); | 5471 | SET_PT_BOTH (opoint, opoint_byte); |
| 5472 | } | 5472 | } |
| 5473 | /* Handling the process output should not deactivate the mark. */ | 5473 | /* Handling the process output should not deactivate the mark. */ |
| @@ -5525,7 +5525,7 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, | |||
| 5525 | 5525 | ||
| 5526 | if ((STRINGP (object) && STRING_MULTIBYTE (object)) | 5526 | if ((STRINGP (object) && STRING_MULTIBYTE (object)) |
| 5527 | || (BUFFERP (object) | 5527 | || (BUFFERP (object) |
| 5528 | && !NILP (B_ (XBUFFER (object), enable_multibyte_characters))) | 5528 | && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters))) |
| 5529 | || EQ (object, Qt)) | 5529 | || EQ (object, Qt)) |
| 5530 | { | 5530 | { |
| 5531 | p->encode_coding_system | 5531 | p->encode_coding_system |
| @@ -6564,7 +6564,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) | |||
| 6564 | is test them for EQness, and none of them should be a string. */ | 6564 | is test them for EQness, and none of them should be a string. */ |
| 6565 | odeactivate = Vdeactivate_mark; | 6565 | odeactivate = Vdeactivate_mark; |
| 6566 | XSETBUFFER (obuffer, current_buffer); | 6566 | XSETBUFFER (obuffer, current_buffer); |
| 6567 | okeymap = B_ (current_buffer, keymap); | 6567 | okeymap = BVAR (current_buffer, keymap); |
| 6568 | 6568 | ||
| 6569 | /* There's no good reason to let sentinels change the current | 6569 | /* There's no good reason to let sentinels change the current |
| 6570 | buffer, and many callers of accept-process-output, sit-for, and | 6570 | buffer, and many callers of accept-process-output, sit-for, and |
| @@ -6714,7 +6714,7 @@ status_notify (struct Lisp_Process *deleting_process) | |||
| 6714 | 6714 | ||
| 6715 | /* Avoid error if buffer is deleted | 6715 | /* Avoid error if buffer is deleted |
| 6716 | (probably that's why the process is dead, too) */ | 6716 | (probably that's why the process is dead, too) */ |
| 6717 | if (NILP (B_ (XBUFFER (buffer), name))) | 6717 | if (NILP (BVAR (XBUFFER (buffer), name))) |
| 6718 | continue; | 6718 | continue; |
| 6719 | Fset_buffer (buffer); | 6719 | Fset_buffer (buffer); |
| 6720 | 6720 | ||
| @@ -6731,13 +6731,13 @@ status_notify (struct Lisp_Process *deleting_process) | |||
| 6731 | before = PT; | 6731 | before = PT; |
| 6732 | before_byte = PT_BYTE; | 6732 | before_byte = PT_BYTE; |
| 6733 | 6733 | ||
| 6734 | tem = B_ (current_buffer, read_only); | 6734 | tem = BVAR (current_buffer, read_only); |
| 6735 | B_ (current_buffer, read_only) = Qnil; | 6735 | BVAR (current_buffer, read_only) = Qnil; |
| 6736 | insert_string ("\nProcess "); | 6736 | insert_string ("\nProcess "); |
| 6737 | Finsert (1, &p->name); | 6737 | Finsert (1, &p->name); |
| 6738 | insert_string (" "); | 6738 | insert_string (" "); |
| 6739 | Finsert (1, &msg); | 6739 | Finsert (1, &msg); |
| 6740 | B_ (current_buffer, read_only) = tem; | 6740 | BVAR (current_buffer, read_only) = tem; |
| 6741 | set_marker_both (p->mark, p->buffer, PT, PT_BYTE); | 6741 | set_marker_both (p->mark, p->buffer, PT, PT_BYTE); |
| 6742 | 6742 | ||
| 6743 | if (opoint >= before) | 6743 | if (opoint >= before) |
| @@ -7136,7 +7136,7 @@ setup_process_coding_systems (Lisp_Object process) | |||
| 7136 | ; | 7136 | ; |
| 7137 | else if (BUFFERP (p->buffer)) | 7137 | else if (BUFFERP (p->buffer)) |
| 7138 | { | 7138 | { |
| 7139 | if (NILP (B_ (XBUFFER (p->buffer), enable_multibyte_characters))) | 7139 | if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters))) |
| 7140 | coding_system = raw_text_coding_system (coding_system); | 7140 | coding_system = raw_text_coding_system (coding_system); |
| 7141 | } | 7141 | } |
| 7142 | setup_coding_system (coding_system, proc_decode_coding_system[inch]); | 7142 | 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 34814687597..8b189baea46 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h | |||
| @@ -181,8 +181,6 @@ struct sigaction { | |||
| 181 | #define HAVE_MENUS 1 | 181 | #define HAVE_MENUS 1 |
| 182 | #endif | 182 | #endif |
| 183 | 183 | ||
| 184 | #define MODE_LINE_BINARY_TEXT(_b_) (NILP (B_(_b_,buffer_file_type)) ? "T" : "B") | ||
| 185 | |||
| 186 | /* Get some redefinitions in place. */ | 184 | /* Get some redefinitions in place. */ |
| 187 | 185 | ||
| 188 | #ifdef emacs | 186 | #ifdef emacs |
| @@ -348,6 +346,8 @@ extern char *get_emacs_configuration_options (void); | |||
| 348 | #endif | 346 | #endif |
| 349 | #include <string.h> | 347 | #include <string.h> |
| 350 | 348 | ||
| 349 | extern int getloadavg (double *, int); | ||
| 350 | |||
| 351 | /* We need a little extra space, see ../../lisp/loadup.el. */ | 351 | /* We need a little extra space, see ../../lisp/loadup.el. */ |
| 352 | #define SYSTEM_PURESIZE_EXTRA 50000 | 352 | #define SYSTEM_PURESIZE_EXTRA 50000 |
| 353 | 353 | ||
diff --git a/src/search.c b/src/search.c index a80e20a8a8a..1e2036f6dc2 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 | |||
| 157 | 157 | ||
| 158 | /* If the compiled pattern hard codes some of the contents of the | 158 | /* If the compiled pattern hard codes some of the contents of the |
| 159 | syntax-table, it can only be reused with *this* syntax table. */ | 159 | syntax-table, it can only be reused with *this* syntax table. */ |
| 160 | cp->syntax_table = cp->buf.used_syntax ? B_ (current_buffer, syntax_table) : Qt; | 160 | cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt; |
| 161 | 161 | ||
| 162 | re_set_whitespace_regexp (NULL); | 162 | re_set_whitespace_regexp (NULL); |
| 163 | 163 | ||
| @@ -236,7 +236,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object tra | |||
| 236 | && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) | 236 | && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) |
| 237 | && cp->posix == posix | 237 | && cp->posix == posix |
| 238 | && (EQ (cp->syntax_table, Qt) | 238 | && (EQ (cp->syntax_table, Qt) |
| 239 | || EQ (cp->syntax_table, B_ (current_buffer, syntax_table))) | 239 | || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table))) |
| 240 | && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)) | 240 | && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)) |
| 241 | && cp->buf.charset_unibyte == charset_unibyte) | 241 | && cp->buf.charset_unibyte == charset_unibyte) |
| 242 | break; | 242 | break; |
| @@ -285,17 +285,17 @@ looking_at_1 (Lisp_Object string, int posix) | |||
| 285 | save_search_regs (); | 285 | save_search_regs (); |
| 286 | 286 | ||
| 287 | /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ | 287 | /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ |
| 288 | XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] | 288 | XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] |
| 289 | = B_ (current_buffer, case_eqv_table); | 289 | = BVAR (current_buffer, case_eqv_table); |
| 290 | 290 | ||
| 291 | CHECK_STRING (string); | 291 | CHECK_STRING (string); |
| 292 | bufp = compile_pattern (string, | 292 | bufp = compile_pattern (string, |
| 293 | (NILP (Vinhibit_changing_match_data) | 293 | (NILP (Vinhibit_changing_match_data) |
| 294 | ? &search_regs : NULL), | 294 | ? &search_regs : NULL), |
| 295 | (!NILP (B_ (current_buffer, case_fold_search)) | 295 | (!NILP (BVAR (current_buffer, case_fold_search)) |
| 296 | ? B_ (current_buffer, case_canon_table) : Qnil), | 296 | ? BVAR (current_buffer, case_canon_table) : Qnil), |
| 297 | posix, | 297 | posix, |
| 298 | !NILP (B_ (current_buffer, enable_multibyte_characters))); | 298 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 299 | 299 | ||
| 300 | immediate_quit = 1; | 300 | immediate_quit = 1; |
| 301 | QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ | 301 | 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 | |||
| 400 | } | 400 | } |
| 401 | 401 | ||
| 402 | /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ | 402 | /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ |
| 403 | XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] | 403 | XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] |
| 404 | = B_ (current_buffer, case_eqv_table); | 404 | = BVAR (current_buffer, case_eqv_table); |
| 405 | 405 | ||
| 406 | bufp = compile_pattern (regexp, | 406 | bufp = compile_pattern (regexp, |
| 407 | (NILP (Vinhibit_changing_match_data) | 407 | (NILP (Vinhibit_changing_match_data) |
| 408 | ? &search_regs : NULL), | 408 | ? &search_regs : NULL), |
| 409 | (!NILP (B_ (current_buffer, case_fold_search)) | 409 | (!NILP (BVAR (current_buffer, case_fold_search)) |
| 410 | ? B_ (current_buffer, case_canon_table) : Qnil), | 410 | ? BVAR (current_buffer, case_canon_table) : Qnil), |
| 411 | posix, | 411 | posix, |
| 412 | STRING_MULTIBYTE (string)); | 412 | STRING_MULTIBYTE (string)); |
| 413 | immediate_quit = 1; | 413 | immediate_quit = 1; |
| @@ -586,7 +586,7 @@ fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_IN | |||
| 586 | s2 = 0; | 586 | s2 = 0; |
| 587 | } | 587 | } |
| 588 | re_match_object = Qnil; | 588 | re_match_object = Qnil; |
| 589 | multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 589 | multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 590 | } | 590 | } |
| 591 | 591 | ||
| 592 | buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); | 592 | 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 | |||
| 608 | static void | 608 | static void |
| 609 | newline_cache_on_off (struct buffer *buf) | 609 | newline_cache_on_off (struct buffer *buf) |
| 610 | { | 610 | { |
| 611 | if (NILP (B_ (buf, cache_long_line_scans))) | 611 | if (NILP (BVAR (buf, cache_long_line_scans))) |
| 612 | { | 612 | { |
| 613 | /* It should be off. */ | 613 | /* It should be off. */ |
| 614 | if (buf->newline_cache) | 614 | if (buf->newline_cache) |
| @@ -996,15 +996,15 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, | |||
| 996 | } | 996 | } |
| 997 | 997 | ||
| 998 | /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ | 998 | /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ |
| 999 | XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] | 999 | XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] |
| 1000 | = B_ (current_buffer, case_eqv_table); | 1000 | = BVAR (current_buffer, case_eqv_table); |
| 1001 | 1001 | ||
| 1002 | np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE, | 1002 | np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE, |
| 1003 | (!NILP (B_ (current_buffer, case_fold_search)) | 1003 | (!NILP (BVAR (current_buffer, case_fold_search)) |
| 1004 | ? B_ (current_buffer, case_canon_table) | 1004 | ? BVAR (current_buffer, case_canon_table) |
| 1005 | : Qnil), | 1005 | : Qnil), |
| 1006 | (!NILP (B_ (current_buffer, case_fold_search)) | 1006 | (!NILP (BVAR (current_buffer, case_fold_search)) |
| 1007 | ? B_ (current_buffer, case_eqv_table) | 1007 | ? BVAR (current_buffer, case_eqv_table) |
| 1008 | : Qnil), | 1008 | : Qnil), |
| 1009 | posix); | 1009 | posix); |
| 1010 | if (np <= 0) | 1010 | if (np <= 0) |
| @@ -1133,7 +1133,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, | |||
| 1133 | (NILP (Vinhibit_changing_match_data) | 1133 | (NILP (Vinhibit_changing_match_data) |
| 1134 | ? &search_regs : &search_regs_1), | 1134 | ? &search_regs : &search_regs_1), |
| 1135 | trt, posix, | 1135 | trt, posix, |
| 1136 | !NILP (B_ (current_buffer, enable_multibyte_characters))); | 1136 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 1137 | 1137 | ||
| 1138 | immediate_quit = 1; /* Quit immediately if user types ^G, | 1138 | immediate_quit = 1; /* Quit immediately if user types ^G, |
| 1139 | because letting this function finish | 1139 | because letting this function finish |
| @@ -1254,7 +1254,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, | |||
| 1254 | EMACS_INT raw_pattern_size; | 1254 | EMACS_INT raw_pattern_size; |
| 1255 | EMACS_INT raw_pattern_size_byte; | 1255 | EMACS_INT raw_pattern_size_byte; |
| 1256 | unsigned char *patbuf; | 1256 | unsigned char *patbuf; |
| 1257 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 1257 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 1258 | unsigned char *base_pat; | 1258 | unsigned char *base_pat; |
| 1259 | /* Set to positive if we find a non-ASCII char that need | 1259 | /* Set to positive if we find a non-ASCII char that need |
| 1260 | translation. Otherwise set to zero later. */ | 1260 | translation. Otherwise set to zero later. */ |
| @@ -1451,7 +1451,7 @@ simple_search (EMACS_INT n, unsigned char *pat, | |||
| 1451 | EMACS_INT pos, EMACS_INT pos_byte, | 1451 | EMACS_INT pos, EMACS_INT pos_byte, |
| 1452 | EMACS_INT lim, EMACS_INT lim_byte) | 1452 | EMACS_INT lim, EMACS_INT lim_byte) |
| 1453 | { | 1453 | { |
| 1454 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 1454 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 1455 | int forward = n > 0; | 1455 | int forward = n > 0; |
| 1456 | /* Number of buffer bytes matched. Note that this may be different | 1456 | /* Number of buffer bytes matched. Note that this may be different |
| 1457 | from len_byte in a multibyte buffer. */ | 1457 | from len_byte in a multibyte buffer. */ |
| @@ -1671,7 +1671,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat, | |||
| 1671 | register EMACS_INT i; | 1671 | register EMACS_INT i; |
| 1672 | register int j; | 1672 | register int j; |
| 1673 | unsigned char *pat, *pat_end; | 1673 | unsigned char *pat, *pat_end; |
| 1674 | int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); | 1674 | int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 1675 | 1675 | ||
| 1676 | unsigned char simple_translate[0400]; | 1676 | unsigned char simple_translate[0400]; |
| 1677 | /* These are set to the preceding bytes of a byte to be translated | 1677 | /* These are set to the preceding bytes of a byte to be translated |
| @@ -2639,7 +2639,7 @@ since only regular expressions have distinguished subexpressions. */) | |||
| 2639 | EMACS_INT length = SBYTES (newtext); | 2639 | EMACS_INT length = SBYTES (newtext); |
| 2640 | unsigned char *substed; | 2640 | unsigned char *substed; |
| 2641 | EMACS_INT substed_alloc_size, substed_len; | 2641 | EMACS_INT substed_alloc_size, substed_len; |
| 2642 | int buf_multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 2642 | int buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 2643 | int str_multibyte = STRING_MULTIBYTE (newtext); | 2643 | int str_multibyte = STRING_MULTIBYTE (newtext); |
| 2644 | Lisp_Object rev_tbl; | 2644 | Lisp_Object rev_tbl; |
| 2645 | int really_changed = 0; | 2645 | int really_changed = 0; |
diff --git a/src/syntax.c b/src/syntax.c index 9aa34014f91..707c2c19f31 100644 --- a/src/syntax.c +++ b/src/syntax.c | |||
| @@ -277,7 +277,7 @@ update_syntax_table (EMACS_INT charpos, int count, int init, | |||
| 277 | else | 277 | else |
| 278 | { | 278 | { |
| 279 | gl_state.use_global = 0; | 279 | gl_state.use_global = 0; |
| 280 | gl_state.current_syntax_table = B_ (current_buffer, syntax_table); | 280 | gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); |
| 281 | } | 281 | } |
| 282 | } | 282 | } |
| 283 | 283 | ||
| @@ -363,7 +363,7 @@ char_quoted (EMACS_INT charpos, EMACS_INT bytepos) | |||
| 363 | static INLINE EMACS_INT | 363 | static INLINE EMACS_INT |
| 364 | dec_bytepos (EMACS_INT bytepos) | 364 | dec_bytepos (EMACS_INT bytepos) |
| 365 | { | 365 | { |
| 366 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 366 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 367 | return bytepos - 1; | 367 | return bytepos - 1; |
| 368 | 368 | ||
| 369 | DEC_POS (bytepos); | 369 | DEC_POS (bytepos); |
| @@ -779,7 +779,7 @@ DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, | |||
| 779 | This is the one specified by the current buffer. */) | 779 | This is the one specified by the current buffer. */) |
| 780 | (void) | 780 | (void) |
| 781 | { | 781 | { |
| 782 | return B_ (current_buffer, syntax_table); | 782 | return BVAR (current_buffer, syntax_table); |
| 783 | } | 783 | } |
| 784 | 784 | ||
| 785 | DEFUN ("standard-syntax-table", Fstandard_syntax_table, | 785 | DEFUN ("standard-syntax-table", Fstandard_syntax_table, |
| @@ -824,7 +824,7 @@ One argument, a syntax table. */) | |||
| 824 | { | 824 | { |
| 825 | int idx; | 825 | int idx; |
| 826 | check_syntax_table (table); | 826 | check_syntax_table (table); |
| 827 | B_ (current_buffer, syntax_table) = table; | 827 | BVAR (current_buffer, syntax_table) = table; |
| 828 | /* Indicate that this buffer now has a specified syntax table. */ | 828 | /* Indicate that this buffer now has a specified syntax table. */ |
| 829 | idx = PER_BUFFER_VAR_IDX (syntax_table); | 829 | idx = PER_BUFFER_VAR_IDX (syntax_table); |
| 830 | SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); | 830 | SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); |
| @@ -1035,7 +1035,7 @@ usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */) | |||
| 1035 | CHECK_CHARACTER (c); | 1035 | CHECK_CHARACTER (c); |
| 1036 | 1036 | ||
| 1037 | if (NILP (syntax_table)) | 1037 | if (NILP (syntax_table)) |
| 1038 | syntax_table = B_ (current_buffer, syntax_table); | 1038 | syntax_table = BVAR (current_buffer, syntax_table); |
| 1039 | else | 1039 | else |
| 1040 | check_syntax_table (syntax_table); | 1040 | check_syntax_table (syntax_table); |
| 1041 | 1041 | ||
| @@ -1450,7 +1450,7 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl | |||
| 1450 | if (XINT (lim) < BEGV) | 1450 | if (XINT (lim) < BEGV) |
| 1451 | XSETFASTINT (lim, BEGV); | 1451 | XSETFASTINT (lim, BEGV); |
| 1452 | 1452 | ||
| 1453 | multibyte = (!NILP (B_ (current_buffer, enable_multibyte_characters)) | 1453 | multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 1454 | && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); | 1454 | && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); |
| 1455 | string_multibyte = SBYTES (string) > SCHARS (string); | 1455 | string_multibyte = SBYTES (string) > SCHARS (string); |
| 1456 | 1456 | ||
| @@ -1936,7 +1936,7 @@ skip_syntaxes (int forwardp, Lisp_Object string, Lisp_Object lim) | |||
| 1936 | if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) | 1936 | if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) |
| 1937 | return make_number (0); | 1937 | return make_number (0); |
| 1938 | 1938 | ||
| 1939 | multibyte = (!NILP (B_ (current_buffer, enable_multibyte_characters)) | 1939 | multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) |
| 1940 | && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); | 1940 | && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); |
| 1941 | 1941 | ||
| 1942 | memset (fastmap, 0, sizeof fastmap); | 1942 | memset (fastmap, 0, sizeof fastmap); |
| @@ -2703,7 +2703,7 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf | |||
| 2703 | while (from > stop) | 2703 | while (from > stop) |
| 2704 | { | 2704 | { |
| 2705 | temp_pos = from_byte; | 2705 | temp_pos = from_byte; |
| 2706 | if (! NILP (B_ (current_buffer, enable_multibyte_characters))) | 2706 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2707 | DEC_POS (temp_pos); | 2707 | DEC_POS (temp_pos); |
| 2708 | else | 2708 | else |
| 2709 | temp_pos--; | 2709 | temp_pos--; |
diff --git a/src/syntax.h b/src/syntax.h index 75937a7c121..e8726bb28a4 100644 --- a/src/syntax.h +++ b/src/syntax.h | |||
| @@ -24,7 +24,7 @@ extern void update_syntax_table (EMACS_INT, int, int, Lisp_Object); | |||
| 24 | 24 | ||
| 25 | /* The standard syntax table is stored where it will automatically | 25 | /* The standard syntax table is stored where it will automatically |
| 26 | be used in all new buffers. */ | 26 | be used in all new buffers. */ |
| 27 | #define Vstandard_syntax_table B_ (&buffer_defaults, syntax_table) | 27 | #define Vstandard_syntax_table BVAR (&buffer_defaults, syntax_table) |
| 28 | 28 | ||
| 29 | /* A syntax table is a chartable whose elements are cons cells | 29 | /* A syntax table is a chartable whose elements are cons cells |
| 30 | (CODE+FLAGS . MATCHING-CHAR). MATCHING-CHAR can be nil if the char | 30 | (CODE+FLAGS . MATCHING-CHAR). MATCHING-CHAR can be nil if the char |
| @@ -79,7 +79,7 @@ enum syntaxcode | |||
| 79 | # define CURRENT_SYNTAX_TABLE gl_state.current_syntax_table | 79 | # define CURRENT_SYNTAX_TABLE gl_state.current_syntax_table |
| 80 | #else | 80 | #else |
| 81 | # define SYNTAX_ENTRY SYNTAX_ENTRY_INT | 81 | # define SYNTAX_ENTRY SYNTAX_ENTRY_INT |
| 82 | # define CURRENT_SYNTAX_TABLE B_ (current_buffer, syntax_table) | 82 | # define CURRENT_SYNTAX_TABLE BVAR (current_buffer, syntax_table) |
| 83 | #endif | 83 | #endif |
| 84 | 84 | ||
| 85 | #define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) | 85 | #define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) |
| @@ -204,7 +204,7 @@ extern char syntax_code_spec[16]; | |||
| 204 | do \ | 204 | do \ |
| 205 | { \ | 205 | { \ |
| 206 | gl_state.use_global = 0; \ | 206 | gl_state.use_global = 0; \ |
| 207 | gl_state.current_syntax_table = B_ (current_buffer, syntax_table); \ | 207 | gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); \ |
| 208 | } while (0) | 208 | } while (0) |
| 209 | 209 | ||
| 210 | /* This macro should be called with FROM at the start of forward | 210 | /* This macro should be called with FROM at the start of forward |
diff --git a/src/term.c b/src/term.c index 1aefe02421f..f082bb40e89 100644 --- a/src/term.c +++ b/src/term.c | |||
| @@ -112,10 +112,7 @@ static void vfatal (const char *str, va_list ap) NO_RETURN; | |||
| 112 | #define OUTPUT_IF(tty, a) \ | 112 | #define OUTPUT_IF(tty, a) \ |
| 113 | do { \ | 113 | do { \ |
| 114 | if (a) \ | 114 | if (a) \ |
| 115 | emacs_tputs ((tty), a, \ | 115 | OUTPUT (tty, a); \ |
| 116 | (int) (FRAME_LINES (XFRAME (selected_frame)) \ | ||
| 117 | - curY (tty) ), \ | ||
| 118 | cmputc); \ | ||
| 119 | } while (0) | 116 | } while (0) |
| 120 | 117 | ||
| 121 | #define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0) | 118 | #define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0) |
| @@ -1350,14 +1347,14 @@ term_get_fkeys_1 (void) | |||
| 1350 | KBOARD *kboard = term_get_fkeys_kboard; | 1347 | KBOARD *kboard = term_get_fkeys_kboard; |
| 1351 | 1348 | ||
| 1352 | /* This can happen if CANNOT_DUMP or with strange options. */ | 1349 | /* This can happen if CANNOT_DUMP or with strange options. */ |
| 1353 | if (!KEYMAPP (kboard->Vinput_decode_map)) | 1350 | if (!KEYMAPP (KVAR (kboard, Vinput_decode_map))) |
| 1354 | kboard->Vinput_decode_map = Fmake_sparse_keymap (Qnil); | 1351 | KVAR (kboard, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); |
| 1355 | 1352 | ||
| 1356 | for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++) | 1353 | for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++) |
| 1357 | { | 1354 | { |
| 1358 | char *sequence = tgetstr (keys[i].cap, address); | 1355 | char *sequence = tgetstr (keys[i].cap, address); |
| 1359 | if (sequence) | 1356 | if (sequence) |
| 1360 | Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), | 1357 | Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), |
| 1361 | Fmake_vector (make_number (1), | 1358 | Fmake_vector (make_number (1), |
| 1362 | intern (keys[i].name))); | 1359 | intern (keys[i].name))); |
| 1363 | } | 1360 | } |
| @@ -1377,13 +1374,13 @@ term_get_fkeys_1 (void) | |||
| 1377 | if (k0) | 1374 | if (k0) |
| 1378 | /* Define f0 first, so that f10 takes precedence in case the | 1375 | /* Define f0 first, so that f10 takes precedence in case the |
| 1379 | key sequences happens to be the same. */ | 1376 | key sequences happens to be the same. */ |
| 1380 | Fdefine_key (kboard->Vinput_decode_map, build_string (k0), | 1377 | Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), |
| 1381 | Fmake_vector (make_number (1), intern ("f0"))); | 1378 | Fmake_vector (make_number (1), intern ("f0"))); |
| 1382 | Fdefine_key (kboard->Vinput_decode_map, build_string (k_semi), | 1379 | Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), |
| 1383 | Fmake_vector (make_number (1), intern ("f10"))); | 1380 | Fmake_vector (make_number (1), intern ("f10"))); |
| 1384 | } | 1381 | } |
| 1385 | else if (k0) | 1382 | else if (k0) |
| 1386 | Fdefine_key (kboard->Vinput_decode_map, build_string (k0), | 1383 | Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), |
| 1387 | Fmake_vector (make_number (1), intern (k0_name))); | 1384 | Fmake_vector (make_number (1), intern (k0_name))); |
| 1388 | } | 1385 | } |
| 1389 | 1386 | ||
| @@ -1406,7 +1403,7 @@ term_get_fkeys_1 (void) | |||
| 1406 | if (sequence) | 1403 | if (sequence) |
| 1407 | { | 1404 | { |
| 1408 | sprintf (fkey, "f%d", i); | 1405 | sprintf (fkey, "f%d", i); |
| 1409 | Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), | 1406 | Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), |
| 1410 | Fmake_vector (make_number (1), | 1407 | Fmake_vector (make_number (1), |
| 1411 | intern (fkey))); | 1408 | intern (fkey))); |
| 1412 | } | 1409 | } |
| @@ -1423,7 +1420,7 @@ term_get_fkeys_1 (void) | |||
| 1423 | { \ | 1420 | { \ |
| 1424 | char *sequence = tgetstr (cap2, address); \ | 1421 | char *sequence = tgetstr (cap2, address); \ |
| 1425 | if (sequence) \ | 1422 | if (sequence) \ |
| 1426 | Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), \ | 1423 | Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \ |
| 1427 | Fmake_vector (make_number (1), \ | 1424 | Fmake_vector (make_number (1), \ |
| 1428 | intern (sym))); \ | 1425 | intern (sym))); \ |
| 1429 | } | 1426 | } |
| @@ -3418,7 +3415,7 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ | |||
| 3418 | 3415 | ||
| 3419 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); | 3416 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); |
| 3420 | init_kboard (terminal->kboard); | 3417 | init_kboard (terminal->kboard); |
| 3421 | terminal->kboard->Vwindow_system = Qnil; | 3418 | KVAR (terminal->kboard, Vwindow_system) = Qnil; |
| 3422 | terminal->kboard->next_kboard = all_kboards; | 3419 | terminal->kboard->next_kboard = all_kboards; |
| 3423 | all_kboards = terminal->kboard; | 3420 | all_kboards = terminal->kboard; |
| 3424 | terminal->kboard->reference_count++; | 3421 | terminal->kboard->reference_count++; |
diff --git a/src/undo.c b/src/undo.c index f6953fabfec..d11cd6f5570 100644 --- a/src/undo.c +++ b/src/undo.c | |||
| @@ -73,12 +73,12 @@ record_point (EMACS_INT pt) | |||
| 73 | Fundo_boundary (); | 73 | Fundo_boundary (); |
| 74 | last_undo_buffer = current_buffer; | 74 | last_undo_buffer = current_buffer; |
| 75 | 75 | ||
| 76 | if (CONSP (B_ (current_buffer, undo_list))) | 76 | if (CONSP (BVAR (current_buffer, undo_list))) |
| 77 | { | 77 | { |
| 78 | /* Set AT_BOUNDARY to 1 only when we have nothing other than | 78 | /* Set AT_BOUNDARY to 1 only when we have nothing other than |
| 79 | marker adjustment before undo boundary. */ | 79 | marker adjustment before undo boundary. */ |
| 80 | 80 | ||
| 81 | Lisp_Object tail = B_ (current_buffer, undo_list), elt; | 81 | Lisp_Object tail = BVAR (current_buffer, undo_list), elt; |
| 82 | 82 | ||
| 83 | while (1) | 83 | while (1) |
| 84 | { | 84 | { |
| @@ -103,8 +103,8 @@ record_point (EMACS_INT pt) | |||
| 103 | if (at_boundary | 103 | if (at_boundary |
| 104 | && current_buffer == last_boundary_buffer | 104 | && current_buffer == last_boundary_buffer |
| 105 | && last_boundary_position != pt) | 105 | && last_boundary_position != pt) |
| 106 | B_ (current_buffer, undo_list) | 106 | BVAR (current_buffer, undo_list) |
| 107 | = Fcons (make_number (last_boundary_position), B_ (current_buffer, undo_list)); | 107 | = Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list)); |
| 108 | } | 108 | } |
| 109 | 109 | ||
| 110 | /* Record an insertion that just happened or is about to happen, | 110 | /* Record an insertion that just happened or is about to happen, |
| @@ -117,17 +117,17 @@ record_insert (EMACS_INT beg, EMACS_INT length) | |||
| 117 | { | 117 | { |
| 118 | Lisp_Object lbeg, lend; | 118 | Lisp_Object lbeg, lend; |
| 119 | 119 | ||
| 120 | if (EQ (B_ (current_buffer, undo_list), Qt)) | 120 | if (EQ (BVAR (current_buffer, undo_list), Qt)) |
| 121 | return; | 121 | return; |
| 122 | 122 | ||
| 123 | record_point (beg); | 123 | record_point (beg); |
| 124 | 124 | ||
| 125 | /* If this is following another insertion and consecutive with it | 125 | /* If this is following another insertion and consecutive with it |
| 126 | in the buffer, combine the two. */ | 126 | in the buffer, combine the two. */ |
| 127 | if (CONSP (B_ (current_buffer, undo_list))) | 127 | if (CONSP (BVAR (current_buffer, undo_list))) |
| 128 | { | 128 | { |
| 129 | Lisp_Object elt; | 129 | Lisp_Object elt; |
| 130 | elt = XCAR (B_ (current_buffer, undo_list)); | 130 | elt = XCAR (BVAR (current_buffer, undo_list)); |
| 131 | if (CONSP (elt) | 131 | if (CONSP (elt) |
| 132 | && INTEGERP (XCAR (elt)) | 132 | && INTEGERP (XCAR (elt)) |
| 133 | && INTEGERP (XCDR (elt)) | 133 | && INTEGERP (XCDR (elt)) |
| @@ -140,8 +140,8 @@ record_insert (EMACS_INT beg, EMACS_INT length) | |||
| 140 | 140 | ||
| 141 | XSETFASTINT (lbeg, beg); | 141 | XSETFASTINT (lbeg, beg); |
| 142 | XSETINT (lend, beg + length); | 142 | XSETINT (lend, beg + length); |
| 143 | B_ (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), | 143 | BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), |
| 144 | B_ (current_buffer, undo_list)); | 144 | BVAR (current_buffer, undo_list)); |
| 145 | } | 145 | } |
| 146 | 146 | ||
| 147 | /* Record that a deletion is about to take place, | 147 | /* Record that a deletion is about to take place, |
| @@ -152,7 +152,7 @@ record_delete (EMACS_INT beg, Lisp_Object string) | |||
| 152 | { | 152 | { |
| 153 | Lisp_Object sbeg; | 153 | Lisp_Object sbeg; |
| 154 | 154 | ||
| 155 | if (EQ (B_ (current_buffer, undo_list), Qt)) | 155 | if (EQ (BVAR (current_buffer, undo_list), Qt)) |
| 156 | return; | 156 | return; |
| 157 | 157 | ||
| 158 | if (PT == beg + SCHARS (string)) | 158 | if (PT == beg + SCHARS (string)) |
| @@ -166,8 +166,8 @@ record_delete (EMACS_INT beg, Lisp_Object string) | |||
| 166 | record_point (beg); | 166 | record_point (beg); |
| 167 | } | 167 | } |
| 168 | 168 | ||
| 169 | B_ (current_buffer, undo_list) | 169 | BVAR (current_buffer, undo_list) |
| 170 | = Fcons (Fcons (string, sbeg), B_ (current_buffer, undo_list)); | 170 | = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)); |
| 171 | } | 171 | } |
| 172 | 172 | ||
| 173 | /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT. | 173 | /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT. |
| @@ -178,7 +178,7 @@ record_delete (EMACS_INT beg, Lisp_Object string) | |||
| 178 | void | 178 | void |
| 179 | record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) | 179 | record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) |
| 180 | { | 180 | { |
| 181 | if (EQ (B_ (current_buffer, undo_list), Qt)) | 181 | if (EQ (BVAR (current_buffer, undo_list), Qt)) |
| 182 | return; | 182 | return; |
| 183 | 183 | ||
| 184 | /* Allocate a cons cell to be the undo boundary after this command. */ | 184 | /* 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) | |||
| 189 | Fundo_boundary (); | 189 | Fundo_boundary (); |
| 190 | last_undo_buffer = current_buffer; | 190 | last_undo_buffer = current_buffer; |
| 191 | 191 | ||
| 192 | B_ (current_buffer, undo_list) | 192 | BVAR (current_buffer, undo_list) |
| 193 | = Fcons (Fcons (marker, make_number (adjustment)), | 193 | = Fcons (Fcons (marker, make_number (adjustment)), |
| 194 | B_ (current_buffer, undo_list)); | 194 | BVAR (current_buffer, undo_list)); |
| 195 | } | 195 | } |
| 196 | 196 | ||
| 197 | /* Record that a replacement is about to take place, | 197 | /* Record that a replacement is about to take place, |
| @@ -215,7 +215,7 @@ record_first_change (void) | |||
| 215 | Lisp_Object high, low; | 215 | Lisp_Object high, low; |
| 216 | struct buffer *base_buffer = current_buffer; | 216 | struct buffer *base_buffer = current_buffer; |
| 217 | 217 | ||
| 218 | if (EQ (B_ (current_buffer, undo_list), Qt)) | 218 | if (EQ (BVAR (current_buffer, undo_list), Qt)) |
| 219 | return; | 219 | return; |
| 220 | 220 | ||
| 221 | if (current_buffer != last_undo_buffer) | 221 | if (current_buffer != last_undo_buffer) |
| @@ -227,7 +227,7 @@ record_first_change (void) | |||
| 227 | 227 | ||
| 228 | XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); | 228 | XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); |
| 229 | XSETFASTINT (low, base_buffer->modtime & 0xffff); | 229 | XSETFASTINT (low, base_buffer->modtime & 0xffff); |
| 230 | B_ (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), B_ (current_buffer, undo_list)); | 230 | BVAR (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), BVAR (current_buffer, undo_list)); |
| 231 | } | 231 | } |
| 232 | 232 | ||
| 233 | /* Record a change in property PROP (whose old value was VAL) | 233 | /* Record a change in property PROP (whose old value was VAL) |
| @@ -242,7 +242,7 @@ record_property_change (EMACS_INT beg, EMACS_INT length, | |||
| 242 | struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); | 242 | struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); |
| 243 | int boundary = 0; | 243 | int boundary = 0; |
| 244 | 244 | ||
| 245 | if (EQ (B_ (buf, undo_list), Qt)) | 245 | if (EQ (BVAR (buf, undo_list), Qt)) |
| 246 | return; | 246 | return; |
| 247 | 247 | ||
| 248 | /* Allocate a cons cell to be the undo boundary after this command. */ | 248 | /* 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, | |||
| 265 | XSETINT (lbeg, beg); | 265 | XSETINT (lbeg, beg); |
| 266 | XSETINT (lend, beg + length); | 266 | XSETINT (lend, beg + length); |
| 267 | entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); | 267 | entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); |
| 268 | B_ (current_buffer, undo_list) = Fcons (entry, B_ (current_buffer, undo_list)); | 268 | BVAR (current_buffer, undo_list) = Fcons (entry, BVAR (current_buffer, undo_list)); |
| 269 | 269 | ||
| 270 | current_buffer = obuf; | 270 | current_buffer = obuf; |
| 271 | } | 271 | } |
| @@ -277,9 +277,9 @@ but another undo command will undo to the previous boundary. */) | |||
| 277 | (void) | 277 | (void) |
| 278 | { | 278 | { |
| 279 | Lisp_Object tem; | 279 | Lisp_Object tem; |
| 280 | if (EQ (B_ (current_buffer, undo_list), Qt)) | 280 | if (EQ (BVAR (current_buffer, undo_list), Qt)) |
| 281 | return Qnil; | 281 | return Qnil; |
| 282 | tem = Fcar (B_ (current_buffer, undo_list)); | 282 | tem = Fcar (BVAR (current_buffer, undo_list)); |
| 283 | if (!NILP (tem)) | 283 | if (!NILP (tem)) |
| 284 | { | 284 | { |
| 285 | /* One way or another, cons nil onto the front of the undo list. */ | 285 | /* 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. */) | |||
| 287 | { | 287 | { |
| 288 | /* If we have preallocated the cons cell to use here, | 288 | /* If we have preallocated the cons cell to use here, |
| 289 | use that one. */ | 289 | use that one. */ |
| 290 | XSETCDR (pending_boundary, B_ (current_buffer, undo_list)); | 290 | XSETCDR (pending_boundary, BVAR (current_buffer, undo_list)); |
| 291 | B_ (current_buffer, undo_list) = pending_boundary; | 291 | BVAR (current_buffer, undo_list) = pending_boundary; |
| 292 | pending_boundary = Qnil; | 292 | pending_boundary = Qnil; |
| 293 | } | 293 | } |
| 294 | else | 294 | else |
| 295 | B_ (current_buffer, undo_list) = Fcons (Qnil, B_ (current_buffer, undo_list)); | 295 | BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list)); |
| 296 | } | 296 | } |
| 297 | last_boundary_position = PT; | 297 | last_boundary_position = PT; |
| 298 | last_boundary_buffer = current_buffer; | 298 | last_boundary_buffer = current_buffer; |
| @@ -321,7 +321,7 @@ truncate_undo_list (struct buffer *b) | |||
| 321 | record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); | 321 | record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); |
| 322 | set_buffer_internal (b); | 322 | set_buffer_internal (b); |
| 323 | 323 | ||
| 324 | list = B_ (b, undo_list); | 324 | list = BVAR (b, undo_list); |
| 325 | 325 | ||
| 326 | prev = Qnil; | 326 | prev = Qnil; |
| 327 | next = list; | 327 | next = list; |
| @@ -433,7 +433,7 @@ truncate_undo_list (struct buffer *b) | |||
| 433 | XSETCDR (last_boundary, Qnil); | 433 | XSETCDR (last_boundary, Qnil); |
| 434 | /* There's nothing we decided to keep, so clear it out. */ | 434 | /* There's nothing we decided to keep, so clear it out. */ |
| 435 | else | 435 | else |
| 436 | B_ (b, undo_list) = Qnil; | 436 | BVAR (b, undo_list) = Qnil; |
| 437 | 437 | ||
| 438 | unbind_to (count, Qnil); | 438 | unbind_to (count, Qnil); |
| 439 | } | 439 | } |
| @@ -470,13 +470,13 @@ Return what remains of the list. */) | |||
| 470 | 470 | ||
| 471 | /* In a writable buffer, enable undoing read-only text that is so | 471 | /* In a writable buffer, enable undoing read-only text that is so |
| 472 | because of text properties. */ | 472 | because of text properties. */ |
| 473 | if (NILP (B_ (current_buffer, read_only))) | 473 | if (NILP (BVAR (current_buffer, read_only))) |
| 474 | specbind (Qinhibit_read_only, Qt); | 474 | specbind (Qinhibit_read_only, Qt); |
| 475 | 475 | ||
| 476 | /* Don't let `intangible' properties interfere with undo. */ | 476 | /* Don't let `intangible' properties interfere with undo. */ |
| 477 | specbind (Qinhibit_point_motion_hooks, Qt); | 477 | specbind (Qinhibit_point_motion_hooks, Qt); |
| 478 | 478 | ||
| 479 | oldlist = B_ (current_buffer, undo_list); | 479 | oldlist = BVAR (current_buffer, undo_list); |
| 480 | 480 | ||
| 481 | while (arg > 0) | 481 | while (arg > 0) |
| 482 | { | 482 | { |
| @@ -631,9 +631,9 @@ Return what remains of the list. */) | |||
| 631 | so the test in `undo' for continuing an undo series | 631 | so the test in `undo' for continuing an undo series |
| 632 | will work right. */ | 632 | will work right. */ |
| 633 | if (did_apply | 633 | if (did_apply |
| 634 | && EQ (oldlist, B_ (current_buffer, undo_list))) | 634 | && EQ (oldlist, BVAR (current_buffer, undo_list))) |
| 635 | B_ (current_buffer, undo_list) | 635 | BVAR (current_buffer, undo_list) |
| 636 | = Fcons (list3 (Qapply, Qcdr, Qnil), B_ (current_buffer, undo_list)); | 636 | = Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)); |
| 637 | 637 | ||
| 638 | UNGCPRO; | 638 | UNGCPRO; |
| 639 | return unbind_to (count, list); | 639 | return unbind_to (count, list); |
diff --git a/src/w32fns.c b/src/w32fns.c index 64e073bedb7..ec48397657a 100644 --- a/src/w32fns.c +++ b/src/w32fns.c | |||
| @@ -4348,9 +4348,9 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 4348 | /* Initialize `default-minibuffer-frame' in case this is the first | 4348 | /* Initialize `default-minibuffer-frame' in case this is the first |
| 4349 | frame on this terminal. */ | 4349 | frame on this terminal. */ |
| 4350 | if (FRAME_HAS_MINIBUF_P (f) | 4350 | if (FRAME_HAS_MINIBUF_P (f) |
| 4351 | && (!FRAMEP (kb->Vdefault_minibuffer_frame) | 4351 | && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) |
| 4352 | || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) | 4352 | || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) |
| 4353 | kb->Vdefault_minibuffer_frame = frame; | 4353 | KVAR (kb, Vdefault_minibuffer_frame) = frame; |
| 4354 | 4354 | ||
| 4355 | /* All remaining specified parameters, which have not been "used" | 4355 | /* All remaining specified parameters, which have not been "used" |
| 4356 | by x_get_arg and friends, now go in the misc. alist of the frame. */ | 4356 | by x_get_arg and friends, now go in the misc. alist of the frame. */ |
| @@ -5225,7 +5225,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, | |||
| 5225 | Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); | 5225 | Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); |
| 5226 | old_buffer = current_buffer; | 5226 | old_buffer = current_buffer; |
| 5227 | set_buffer_internal_1 (XBUFFER (buffer)); | 5227 | set_buffer_internal_1 (XBUFFER (buffer)); |
| 5228 | B_ (current_buffer, truncate_lines) = Qnil; | 5228 | BVAR (current_buffer, truncate_lines) = Qnil; |
| 5229 | specbind (Qinhibit_read_only, Qt); | 5229 | specbind (Qinhibit_read_only, Qt); |
| 5230 | specbind (Qinhibit_modification_hooks, Qt); | 5230 | specbind (Qinhibit_modification_hooks, Qt); |
| 5231 | Ferase_buffer (); | 5231 | Ferase_buffer (); |
| @@ -5655,7 +5655,7 @@ Text larger than the specified size is clipped. */) | |||
| 5655 | /* Display the tooltip text in a temporary buffer. */ | 5655 | /* Display the tooltip text in a temporary buffer. */ |
| 5656 | old_buffer = current_buffer; | 5656 | old_buffer = current_buffer; |
| 5657 | set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); | 5657 | set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); |
| 5658 | B_ (current_buffer, truncate_lines) = Qnil; | 5658 | BVAR (current_buffer, truncate_lines) = Qnil; |
| 5659 | clear_glyph_matrix (w->desired_matrix); | 5659 | clear_glyph_matrix (w->desired_matrix); |
| 5660 | clear_glyph_matrix (w->current_matrix); | 5660 | clear_glyph_matrix (w->current_matrix); |
| 5661 | SET_TEXT_POS (pos, BEGV, BEGV_BYTE); | 5661 | SET_TEXT_POS (pos, BEGV, BEGV_BYTE); |
| @@ -6162,7 +6162,7 @@ an integer representing a ShowWindow flag: | |||
| 6162 | CHECK_STRING (document); | 6162 | CHECK_STRING (document); |
| 6163 | 6163 | ||
| 6164 | /* Encode filename, current directory and parameters. */ | 6164 | /* Encode filename, current directory and parameters. */ |
| 6165 | current_dir = ENCODE_FILE (B_ (current_buffer, directory)); | 6165 | current_dir = ENCODE_FILE (BVAR (current_buffer, directory)); |
| 6166 | document = ENCODE_FILE (document); | 6166 | document = ENCODE_FILE (document); |
| 6167 | if (STRINGP (parameters)) | 6167 | if (STRINGP (parameters)) |
| 6168 | parameters = ENCODE_SYSTEM (parameters); | 6168 | parameters = ENCODE_SYSTEM (parameters); |
diff --git a/src/w32term.c b/src/w32term.c index cd4ee54fd2c..692130b5140 100644 --- a/src/w32term.c +++ b/src/w32term.c | |||
| @@ -6082,7 +6082,7 @@ w32_create_terminal (struct w32_display_info *dpyinfo) | |||
| 6082 | terminal like X does. */ | 6082 | terminal like X does. */ |
| 6083 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); | 6083 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); |
| 6084 | init_kboard (terminal->kboard); | 6084 | init_kboard (terminal->kboard); |
| 6085 | terminal->kboard->Vwindow_system = intern ("w32"); | 6085 | KVAR (terminal->kboard, Vwindow_system) = intern ("w32"); |
| 6086 | terminal->kboard->next_kboard = all_kboards; | 6086 | terminal->kboard->next_kboard = all_kboards; |
| 6087 | all_kboards = terminal->kboard; | 6087 | all_kboards = terminal->kboard; |
| 6088 | /* Don't let the initial kboard remain current longer than necessary. | 6088 | /* Don't let the initial kboard remain current longer than necessary. |
diff --git a/src/window.c b/src/window.c index 4d700cfad5e..7965269f0e7 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -1359,8 +1359,8 @@ window_display_table (struct window *w) | |||
| 1359 | { | 1359 | { |
| 1360 | struct buffer *b = XBUFFER (w->buffer); | 1360 | struct buffer *b = XBUFFER (w->buffer); |
| 1361 | 1361 | ||
| 1362 | if (DISP_TABLE_P (B_ (b, display_table))) | 1362 | if (DISP_TABLE_P (BVAR (b, display_table))) |
| 1363 | dp = XCHAR_TABLE (B_ (b, display_table)); | 1363 | dp = XCHAR_TABLE (BVAR (b, display_table)); |
| 1364 | else if (DISP_TABLE_P (Vstandard_display_table)) | 1364 | else if (DISP_TABLE_P (Vstandard_display_table)) |
| 1365 | dp = XCHAR_TABLE (Vstandard_display_table); | 1365 | dp = XCHAR_TABLE (Vstandard_display_table); |
| 1366 | } | 1366 | } |
| @@ -1414,9 +1414,9 @@ unshow_buffer (register struct window *w) | |||
| 1414 | So don't clobber point in that buffer. */ | 1414 | So don't clobber point in that buffer. */ |
| 1415 | if (! EQ (buf, XWINDOW (selected_window)->buffer) | 1415 | if (! EQ (buf, XWINDOW (selected_window)->buffer) |
| 1416 | /* This line helps to fix Horsley's testbug.el bug. */ | 1416 | /* This line helps to fix Horsley's testbug.el bug. */ |
| 1417 | && !(WINDOWP (B_ (b, last_selected_window)) | 1417 | && !(WINDOWP (BVAR (b, last_selected_window)) |
| 1418 | && w != XWINDOW (B_ (b, last_selected_window)) | 1418 | && w != XWINDOW (BVAR (b, last_selected_window)) |
| 1419 | && EQ (buf, XWINDOW (B_ (b, last_selected_window))->buffer))) | 1419 | && EQ (buf, XWINDOW (BVAR (b, last_selected_window))->buffer))) |
| 1420 | temp_set_point_both (b, | 1420 | temp_set_point_both (b, |
| 1421 | clip_to_bounds (BUF_BEGV (b), | 1421 | clip_to_bounds (BUF_BEGV (b), |
| 1422 | XMARKER (w->pointm)->charpos, | 1422 | XMARKER (w->pointm)->charpos, |
| @@ -1425,9 +1425,9 @@ unshow_buffer (register struct window *w) | |||
| 1425 | marker_byte_position (w->pointm), | 1425 | marker_byte_position (w->pointm), |
| 1426 | BUF_ZV_BYTE (b))); | 1426 | BUF_ZV_BYTE (b))); |
| 1427 | 1427 | ||
| 1428 | if (WINDOWP (B_ (b, last_selected_window)) | 1428 | if (WINDOWP (BVAR (b, last_selected_window)) |
| 1429 | && w == XWINDOW (B_ (b, last_selected_window))) | 1429 | && w == XWINDOW (BVAR (b, last_selected_window))) |
| 1430 | B_ (b, last_selected_window) = Qnil; | 1430 | BVAR (b, last_selected_window) = Qnil; |
| 1431 | } | 1431 | } |
| 1432 | 1432 | ||
| 1433 | /* Put replacement into the window structure in place of old. */ | 1433 | /* 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 | |||
| 2325 | /* Check for a window that has a killed buffer. */ | 2325 | /* Check for a window that has a killed buffer. */ |
| 2326 | case CHECK_ALL_WINDOWS: | 2326 | case CHECK_ALL_WINDOWS: |
| 2327 | if (! NILP (w->buffer) | 2327 | if (! NILP (w->buffer) |
| 2328 | && NILP (B_ (XBUFFER (w->buffer), name))) | 2328 | && NILP (BVAR (XBUFFER (w->buffer), name))) |
| 2329 | abort (); | 2329 | abort (); |
| 2330 | break; | 2330 | break; |
| 2331 | 2331 | ||
| @@ -2729,7 +2729,7 @@ window_min_size_2 (struct window *w, int width_p, int safe_p) | |||
| 2729 | { | 2729 | { |
| 2730 | int safe_size = (MIN_SAFE_WINDOW_HEIGHT | 2730 | int safe_size = (MIN_SAFE_WINDOW_HEIGHT |
| 2731 | + ((BUFFERP (w->buffer) | 2731 | + ((BUFFERP (w->buffer) |
| 2732 | && !NILP (B_ (XBUFFER (w->buffer), mode_line_format))) | 2732 | && !NILP (BVAR (XBUFFER (w->buffer), mode_line_format))) |
| 2733 | ? 1 : 0)); | 2733 | ? 1 : 0)); |
| 2734 | 2734 | ||
| 2735 | return safe_p ? safe_size : max (window_min_height, safe_size); | 2735 | 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 | |||
| 3360 | w->buffer = buffer; | 3360 | w->buffer = buffer; |
| 3361 | 3361 | ||
| 3362 | if (EQ (window, selected_window)) | 3362 | if (EQ (window, selected_window)) |
| 3363 | B_ (b, last_selected_window) = window; | 3363 | BVAR (b, last_selected_window) = window; |
| 3364 | 3364 | ||
| 3365 | /* Let redisplay errors through. */ | 3365 | /* Let redisplay errors through. */ |
| 3366 | b->display_error_modiff = 0; | 3366 | b->display_error_modiff = 0; |
| 3367 | 3367 | ||
| 3368 | /* Update time stamps of buffer display. */ | 3368 | /* Update time stamps of buffer display. */ |
| 3369 | if (INTEGERP (B_ (b, display_count))) | 3369 | if (INTEGERP (BVAR (b, display_count))) |
| 3370 | XSETINT (B_ (b, display_count), XINT (B_ (b, display_count)) + 1); | 3370 | XSETINT (BVAR (b, display_count), XINT (BVAR (b, display_count)) + 1); |
| 3371 | B_ (b, display_time) = Fcurrent_time (); | 3371 | BVAR (b, display_time) = Fcurrent_time (); |
| 3372 | 3372 | ||
| 3373 | XSETFASTINT (w->window_end_pos, 0); | 3373 | XSETFASTINT (w->window_end_pos, 0); |
| 3374 | XSETFASTINT (w->window_end_vpos, 0); | 3374 | XSETFASTINT (w->window_end_vpos, 0); |
| @@ -3421,18 +3421,18 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int | |||
| 3421 | w->left_margin_cols = w->right_margin_cols = Qnil; | 3421 | w->left_margin_cols = w->right_margin_cols = Qnil; |
| 3422 | 3422 | ||
| 3423 | Fset_window_fringes (window, | 3423 | Fset_window_fringes (window, |
| 3424 | B_ (b, left_fringe_width), B_ (b, right_fringe_width), | 3424 | BVAR (b, left_fringe_width), BVAR (b, right_fringe_width), |
| 3425 | B_ (b, fringes_outside_margins)); | 3425 | BVAR (b, fringes_outside_margins)); |
| 3426 | 3426 | ||
| 3427 | Fset_window_scroll_bars (window, | 3427 | Fset_window_scroll_bars (window, |
| 3428 | B_ (b, scroll_bar_width), | 3428 | BVAR (b, scroll_bar_width), |
| 3429 | B_ (b, vertical_scroll_bar_type), Qnil); | 3429 | BVAR (b, vertical_scroll_bar_type), Qnil); |
| 3430 | 3430 | ||
| 3431 | w->left_margin_cols = save_left; | 3431 | w->left_margin_cols = save_left; |
| 3432 | w->right_margin_cols = save_right; | 3432 | w->right_margin_cols = save_right; |
| 3433 | 3433 | ||
| 3434 | Fset_window_margins (window, | 3434 | Fset_window_margins (window, |
| 3435 | B_ (b, left_margin_cols), B_ (b, right_margin_cols)); | 3435 | BVAR (b, left_margin_cols), BVAR (b, right_margin_cols)); |
| 3436 | } | 3436 | } |
| 3437 | 3437 | ||
| 3438 | if (run_hooks_p) | 3438 | if (run_hooks_p) |
| @@ -3469,7 +3469,7 @@ This function runs `window-scroll-functions' before running | |||
| 3469 | XSETWINDOW (window, w); | 3469 | XSETWINDOW (window, w); |
| 3470 | buffer = Fget_buffer (buffer_or_name); | 3470 | buffer = Fget_buffer (buffer_or_name); |
| 3471 | CHECK_BUFFER (buffer); | 3471 | CHECK_BUFFER (buffer); |
| 3472 | if (NILP (B_ (XBUFFER (buffer), name))) | 3472 | if (NILP (BVAR (XBUFFER (buffer), name))) |
| 3473 | error ("Attempt to display deleted buffer"); | 3473 | error ("Attempt to display deleted buffer"); |
| 3474 | 3474 | ||
| 3475 | tem = w->buffer; | 3475 | tem = w->buffer; |
| @@ -3481,7 +3481,7 @@ This function runs `window-scroll-functions' before running | |||
| 3481 | if (EQ (tem, buffer)) | 3481 | if (EQ (tem, buffer)) |
| 3482 | return Qnil; | 3482 | return Qnil; |
| 3483 | else if (EQ (w->dedicated, Qt)) | 3483 | else if (EQ (w->dedicated, Qt)) |
| 3484 | error ("Window is dedicated to `%s'", SDATA (B_ (XBUFFER (tem), name))); | 3484 | error ("Window is dedicated to `%s'", SDATA (BVAR (XBUFFER (tem), name))); |
| 3485 | else | 3485 | else |
| 3486 | w->dedicated = Qnil; | 3486 | w->dedicated = Qnil; |
| 3487 | 3487 | ||
| @@ -3552,7 +3552,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) | |||
| 3552 | 3552 | ||
| 3553 | Fset_buffer (w->buffer); | 3553 | Fset_buffer (w->buffer); |
| 3554 | 3554 | ||
| 3555 | B_ (XBUFFER (w->buffer), last_selected_window) = window; | 3555 | BVAR (XBUFFER (w->buffer), last_selected_window) = window; |
| 3556 | 3556 | ||
| 3557 | /* Go to the point recorded in the window. | 3557 | /* Go to the point recorded in the window. |
| 3558 | This is important when the buffer is in more | 3558 | This is important when the buffer is in more |
| @@ -3640,7 +3640,7 @@ displaying that buffer. */) | |||
| 3640 | 3640 | ||
| 3641 | if (STRINGP (object)) | 3641 | if (STRINGP (object)) |
| 3642 | object = Fget_buffer (object); | 3642 | object = Fget_buffer (object); |
| 3643 | if (BUFFERP (object) && !NILP (B_ (XBUFFER (object), name))) | 3643 | if (BUFFERP (object) && !NILP (BVAR (XBUFFER (object), name))) |
| 3644 | { | 3644 | { |
| 3645 | /* Walk all windows looking for buffer, and force update | 3645 | /* Walk all windows looking for buffer, and force update |
| 3646 | of each of those windows. */ | 3646 | of each of those windows. */ |
| @@ -3663,7 +3663,7 @@ temp_output_buffer_show (register Lisp_Object buf) | |||
| 3663 | register Lisp_Object window; | 3663 | register Lisp_Object window; |
| 3664 | register struct window *w; | 3664 | register struct window *w; |
| 3665 | 3665 | ||
| 3666 | B_ (XBUFFER (buf), directory) = B_ (current_buffer, directory); | 3666 | BVAR (XBUFFER (buf), directory) = BVAR (current_buffer, directory); |
| 3667 | 3667 | ||
| 3668 | Fset_buffer (buf); | 3668 | Fset_buffer (buf); |
| 3669 | BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; | 3669 | BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; |
| @@ -4834,8 +4834,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) | |||
| 4834 | possibility of point becoming "stuck" on a tall line when | 4834 | possibility of point becoming "stuck" on a tall line when |
| 4835 | scrolling by one line. */ | 4835 | scrolling by one line. */ |
| 4836 | if (window_scroll_pixel_based_preserve_y < 0 | 4836 | if (window_scroll_pixel_based_preserve_y < 0 |
| 4837 | || !SYMBOLP (current_kboard->Vlast_command) | 4837 | || !SYMBOLP (KVAR (current_kboard, Vlast_command)) |
| 4838 | || NILP (Fget (current_kboard->Vlast_command, Qscroll_command))) | 4838 | || NILP (Fget (KVAR (current_kboard, Vlast_command), Qscroll_command))) |
| 4839 | { | 4839 | { |
| 4840 | start_display (&it, w, start); | 4840 | start_display (&it, w, start); |
| 4841 | move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); | 4841 | move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); |
| @@ -5091,8 +5091,8 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror) | |||
| 5091 | if (!NILP (Vscroll_preserve_screen_position)) | 5091 | if (!NILP (Vscroll_preserve_screen_position)) |
| 5092 | { | 5092 | { |
| 5093 | if (window_scroll_preserve_vpos <= 0 | 5093 | if (window_scroll_preserve_vpos <= 0 |
| 5094 | || !SYMBOLP (current_kboard->Vlast_command) | 5094 | || !SYMBOLP (KVAR (current_kboard, Vlast_command)) |
| 5095 | || NILP (Fget (current_kboard->Vlast_command, Qscroll_command))) | 5095 | || NILP (Fget (KVAR (current_kboard, Vlast_command), Qscroll_command))) |
| 5096 | { | 5096 | { |
| 5097 | struct position posit | 5097 | struct position posit |
| 5098 | = *compute_motion (startpos, 0, 0, 0, | 5098 | = *compute_motion (startpos, 0, 0, 0, |
| @@ -5878,7 +5878,7 @@ the return value is nil. Otherwise the value is t. */) | |||
| 5878 | saved_windows = XVECTOR (data->saved_windows); | 5878 | saved_windows = XVECTOR (data->saved_windows); |
| 5879 | 5879 | ||
| 5880 | new_current_buffer = data->current_buffer; | 5880 | new_current_buffer = data->current_buffer; |
| 5881 | if (NILP (B_ (XBUFFER (new_current_buffer), name))) | 5881 | if (NILP (BVAR (XBUFFER (new_current_buffer), name))) |
| 5882 | new_current_buffer = Qnil; | 5882 | new_current_buffer = Qnil; |
| 5883 | else | 5883 | else |
| 5884 | { | 5884 | { |
| @@ -6063,14 +6063,14 @@ the return value is nil. Otherwise the value is t. */) | |||
| 6063 | w->buffer = p->buffer; | 6063 | w->buffer = p->buffer; |
| 6064 | else | 6064 | else |
| 6065 | { | 6065 | { |
| 6066 | if (!NILP (B_ (XBUFFER (p->buffer), name))) | 6066 | if (!NILP (BVAR (XBUFFER (p->buffer), name))) |
| 6067 | /* If saved buffer is alive, install it. */ | 6067 | /* If saved buffer is alive, install it. */ |
| 6068 | { | 6068 | { |
| 6069 | w->buffer = p->buffer; | 6069 | w->buffer = p->buffer; |
| 6070 | w->start_at_line_beg = p->start_at_line_beg; | 6070 | w->start_at_line_beg = p->start_at_line_beg; |
| 6071 | set_marker_restricted (w->start, p->start, w->buffer); | 6071 | set_marker_restricted (w->start, p->start, w->buffer); |
| 6072 | set_marker_restricted (w->pointm, p->pointm, w->buffer); | 6072 | set_marker_restricted (w->pointm, p->pointm, w->buffer); |
| 6073 | Fset_marker (B_ (XBUFFER (w->buffer), mark), | 6073 | Fset_marker (BVAR (XBUFFER (w->buffer), mark), |
| 6074 | p->mark, w->buffer); | 6074 | p->mark, w->buffer); |
| 6075 | 6075 | ||
| 6076 | /* As documented in Fcurrent_window_configuration, don't | 6076 | /* As documented in Fcurrent_window_configuration, don't |
| @@ -6080,7 +6080,7 @@ the return value is nil. Otherwise the value is t. */) | |||
| 6080 | && XBUFFER (p->buffer) == current_buffer) | 6080 | && XBUFFER (p->buffer) == current_buffer) |
| 6081 | Fgoto_char (w->pointm); | 6081 | Fgoto_char (w->pointm); |
| 6082 | } | 6082 | } |
| 6083 | else if (NILP (w->buffer) || NILP (B_ (XBUFFER (w->buffer), name))) | 6083 | else if (NILP (w->buffer) || NILP (BVAR (XBUFFER (w->buffer), name))) |
| 6084 | /* Else unless window has a live buffer, get one. */ | 6084 | /* Else unless window has a live buffer, get one. */ |
| 6085 | { | 6085 | { |
| 6086 | w->buffer = Fcdr (Fcar (Vbuffer_alist)); | 6086 | w->buffer = Fcdr (Fcar (Vbuffer_alist)); |
| @@ -6121,7 +6121,7 @@ the return value is nil. Otherwise the value is t. */) | |||
| 6121 | has been restored into it. We already swapped out that point | 6121 | has been restored into it. We already swapped out that point |
| 6122 | from that window's old buffer. */ | 6122 | from that window's old buffer. */ |
| 6123 | select_window (data->current_window, Qnil, 1); | 6123 | select_window (data->current_window, Qnil, 1); |
| 6124 | B_ (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) | 6124 | BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) |
| 6125 | = selected_window; | 6125 | = selected_window; |
| 6126 | 6126 | ||
| 6127 | if (NILP (data->focus_frame) | 6127 | if (NILP (data->focus_frame) |
| @@ -6322,7 +6322,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) | |||
| 6322 | p->start = Fcopy_marker (w->start, Qnil); | 6322 | p->start = Fcopy_marker (w->start, Qnil); |
| 6323 | p->start_at_line_beg = w->start_at_line_beg; | 6323 | p->start_at_line_beg = w->start_at_line_beg; |
| 6324 | 6324 | ||
| 6325 | tem = B_ (XBUFFER (w->buffer), mark); | 6325 | tem = BVAR (XBUFFER (w->buffer), mark); |
| 6326 | p->mark = Fcopy_marker (tem, Qnil); | 6326 | p->mark = Fcopy_marker (tem, Qnil); |
| 6327 | } | 6327 | } |
| 6328 | else | 6328 | else |
diff --git a/src/xdisp.c b/src/xdisp.c index 68f7835f0d7..37fd9e4aaab 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, | |||
| 1210 | if (WINDOW_WANTS_MODELINE_P (w)) | 1210 | if (WINDOW_WANTS_MODELINE_P (w)) |
| 1211 | current_mode_line_height | 1211 | current_mode_line_height |
| 1212 | = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), | 1212 | = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), |
| 1213 | B_ (current_buffer, mode_line_format)); | 1213 | BVAR (current_buffer, mode_line_format)); |
| 1214 | 1214 | ||
| 1215 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 1215 | if (WINDOW_WANTS_HEADER_LINE_P (w)) |
| 1216 | current_header_line_height | 1216 | current_header_line_height |
| 1217 | = display_mode_line (w, HEADER_LINE_FACE_ID, | 1217 | = display_mode_line (w, HEADER_LINE_FACE_ID, |
| 1218 | B_ (current_buffer, header_line_format)); | 1218 | BVAR (current_buffer, header_line_format)); |
| 1219 | 1219 | ||
| 1220 | start_display (&it, w, top); | 1220 | start_display (&it, w, top); |
| 1221 | move_it_to (&it, charpos, -1, it.last_visible_y-1, -1, | 1221 | move_it_to (&it, charpos, -1, it.last_visible_y-1, -1, |
| @@ -2405,10 +2405,10 @@ init_iterator (struct it *it, struct window *w, | |||
| 2405 | if (base_face_id == DEFAULT_FACE_ID | 2405 | if (base_face_id == DEFAULT_FACE_ID |
| 2406 | && FRAME_WINDOW_P (it->f)) | 2406 | && FRAME_WINDOW_P (it->f)) |
| 2407 | { | 2407 | { |
| 2408 | if (NATNUMP (B_ (current_buffer, extra_line_spacing))) | 2408 | if (NATNUMP (BVAR (current_buffer, extra_line_spacing))) |
| 2409 | it->extra_line_spacing = XFASTINT (B_ (current_buffer, extra_line_spacing)); | 2409 | it->extra_line_spacing = XFASTINT (BVAR (current_buffer, extra_line_spacing)); |
| 2410 | else if (FLOATP (B_ (current_buffer, extra_line_spacing))) | 2410 | else if (FLOATP (BVAR (current_buffer, extra_line_spacing))) |
| 2411 | it->extra_line_spacing = (XFLOAT_DATA (B_ (current_buffer, extra_line_spacing)) | 2411 | it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) |
| 2412 | * FRAME_LINE_HEIGHT (it->f)); | 2412 | * FRAME_LINE_HEIGHT (it->f)); |
| 2413 | else if (it->f->extra_line_spacing > 0) | 2413 | else if (it->f->extra_line_spacing > 0) |
| 2414 | it->extra_line_spacing = it->f->extra_line_spacing; | 2414 | it->extra_line_spacing = it->f->extra_line_spacing; |
| @@ -2431,36 +2431,36 @@ init_iterator (struct it *it, struct window *w, | |||
| 2431 | it->override_ascent = -1; | 2431 | it->override_ascent = -1; |
| 2432 | 2432 | ||
| 2433 | /* Are control characters displayed as `^C'? */ | 2433 | /* Are control characters displayed as `^C'? */ |
| 2434 | it->ctl_arrow_p = !NILP (B_ (current_buffer, ctl_arrow)); | 2434 | it->ctl_arrow_p = !NILP (BVAR (current_buffer, ctl_arrow)); |
| 2435 | 2435 | ||
| 2436 | /* -1 means everything between a CR and the following line end | 2436 | /* -1 means everything between a CR and the following line end |
| 2437 | is invisible. >0 means lines indented more than this value are | 2437 | is invisible. >0 means lines indented more than this value are |
| 2438 | invisible. */ | 2438 | invisible. */ |
| 2439 | it->selective = (INTEGERP (B_ (current_buffer, selective_display)) | 2439 | it->selective = (INTEGERP (BVAR (current_buffer, selective_display)) |
| 2440 | ? XFASTINT (B_ (current_buffer, selective_display)) | 2440 | ? XFASTINT (BVAR (current_buffer, selective_display)) |
| 2441 | : (!NILP (B_ (current_buffer, selective_display)) | 2441 | : (!NILP (BVAR (current_buffer, selective_display)) |
| 2442 | ? -1 : 0)); | 2442 | ? -1 : 0)); |
| 2443 | it->selective_display_ellipsis_p | 2443 | it->selective_display_ellipsis_p |
| 2444 | = !NILP (B_ (current_buffer, selective_display_ellipses)); | 2444 | = !NILP (BVAR (current_buffer, selective_display_ellipses)); |
| 2445 | 2445 | ||
| 2446 | /* Display table to use. */ | 2446 | /* Display table to use. */ |
| 2447 | it->dp = window_display_table (w); | 2447 | it->dp = window_display_table (w); |
| 2448 | 2448 | ||
| 2449 | /* Are multibyte characters enabled in current_buffer? */ | 2449 | /* Are multibyte characters enabled in current_buffer? */ |
| 2450 | it->multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 2450 | it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 2451 | 2451 | ||
| 2452 | /* Do we need to reorder bidirectional text? Not if this is a | 2452 | /* Do we need to reorder bidirectional text? Not if this is a |
| 2453 | unibyte buffer: by definition, none of the single-byte characters | 2453 | unibyte buffer: by definition, none of the single-byte characters |
| 2454 | are strong R2L, so no reordering is needed. And bidi.c doesn't | 2454 | are strong R2L, so no reordering is needed. And bidi.c doesn't |
| 2455 | support unibyte buffers anyway. */ | 2455 | support unibyte buffers anyway. */ |
| 2456 | it->bidi_p | 2456 | it->bidi_p |
| 2457 | = !NILP (B_ (current_buffer, bidi_display_reordering)) && it->multibyte_p; | 2457 | = !NILP (BVAR (current_buffer, bidi_display_reordering)) && it->multibyte_p; |
| 2458 | 2458 | ||
| 2459 | /* Non-zero if we should highlight the region. */ | 2459 | /* Non-zero if we should highlight the region. */ |
| 2460 | highlight_region_p | 2460 | highlight_region_p |
| 2461 | = (!NILP (Vtransient_mark_mode) | 2461 | = (!NILP (Vtransient_mark_mode) |
| 2462 | && !NILP (B_ (current_buffer, mark_active)) | 2462 | && !NILP (BVAR (current_buffer, mark_active)) |
| 2463 | && XMARKER (B_ (current_buffer, mark))->buffer != 0); | 2463 | && XMARKER (BVAR (current_buffer, mark))->buffer != 0); |
| 2464 | 2464 | ||
| 2465 | /* Set IT->region_beg_charpos and IT->region_end_charpos to the | 2465 | /* Set IT->region_beg_charpos and IT->region_end_charpos to the |
| 2466 | start and end of a visible region in window IT->w. Set both to | 2466 | 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, | |||
| 2477 | && WINDOWP (minibuf_selected_window) | 2477 | && WINDOWP (minibuf_selected_window) |
| 2478 | && w == XWINDOW (minibuf_selected_window)))) | 2478 | && w == XWINDOW (minibuf_selected_window)))) |
| 2479 | { | 2479 | { |
| 2480 | EMACS_INT charpos = marker_position (B_ (current_buffer, mark)); | 2480 | EMACS_INT charpos = marker_position (BVAR (current_buffer, mark)); |
| 2481 | it->region_beg_charpos = min (PT, charpos); | 2481 | it->region_beg_charpos = min (PT, charpos); |
| 2482 | it->region_end_charpos = max (PT, charpos); | 2482 | it->region_end_charpos = max (PT, charpos); |
| 2483 | } | 2483 | } |
| @@ -2494,7 +2494,7 @@ init_iterator (struct it *it, struct window *w, | |||
| 2494 | it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger); | 2494 | it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger); |
| 2495 | 2495 | ||
| 2496 | /* Correct bogus values of tab_width. */ | 2496 | /* Correct bogus values of tab_width. */ |
| 2497 | it->tab_width = XINT (B_ (current_buffer, tab_width)); | 2497 | it->tab_width = XINT (BVAR (current_buffer, tab_width)); |
| 2498 | if (it->tab_width <= 0 || it->tab_width > 1000) | 2498 | if (it->tab_width <= 0 || it->tab_width > 1000) |
| 2499 | it->tab_width = 8; | 2499 | it->tab_width = 8; |
| 2500 | 2500 | ||
| @@ -2508,8 +2508,8 @@ init_iterator (struct it *it, struct window *w, | |||
| 2508 | && (WINDOW_TOTAL_COLS (it->w) | 2508 | && (WINDOW_TOTAL_COLS (it->w) |
| 2509 | < XINT (Vtruncate_partial_width_windows)))))) | 2509 | < XINT (Vtruncate_partial_width_windows)))))) |
| 2510 | it->line_wrap = TRUNCATE; | 2510 | it->line_wrap = TRUNCATE; |
| 2511 | else if (NILP (B_ (current_buffer, truncate_lines))) | 2511 | else if (NILP (BVAR (current_buffer, truncate_lines))) |
| 2512 | it->line_wrap = NILP (B_ (current_buffer, word_wrap)) | 2512 | it->line_wrap = NILP (BVAR (current_buffer, word_wrap)) |
| 2513 | ? WINDOW_WRAP : WORD_WRAP; | 2513 | ? WINDOW_WRAP : WORD_WRAP; |
| 2514 | else | 2514 | else |
| 2515 | it->line_wrap = TRUNCATE; | 2515 | it->line_wrap = TRUNCATE; |
| @@ -2611,9 +2611,9 @@ init_iterator (struct it *it, struct window *w, | |||
| 2611 | { | 2611 | { |
| 2612 | /* Note the paragraph direction that this buffer wants to | 2612 | /* Note the paragraph direction that this buffer wants to |
| 2613 | use. */ | 2613 | use. */ |
| 2614 | if (EQ (B_ (current_buffer, bidi_paragraph_direction), Qleft_to_right)) | 2614 | if (EQ (BVAR (current_buffer, bidi_paragraph_direction), Qleft_to_right)) |
| 2615 | it->paragraph_embedding = L2R; | 2615 | it->paragraph_embedding = L2R; |
| 2616 | else if (EQ (B_ (current_buffer, bidi_paragraph_direction), Qright_to_left)) | 2616 | else if (EQ (BVAR (current_buffer, bidi_paragraph_direction), Qright_to_left)) |
| 2617 | it->paragraph_embedding = R2L; | 2617 | it->paragraph_embedding = R2L; |
| 2618 | else | 2618 | else |
| 2619 | it->paragraph_embedding = NEUTRAL_DIR; | 2619 | it->paragraph_embedding = NEUTRAL_DIR; |
| @@ -5411,7 +5411,7 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p) | |||
| 5411 | it->method = GET_FROM_BUFFER; | 5411 | it->method = GET_FROM_BUFFER; |
| 5412 | it->object = it->w->buffer; | 5412 | it->object = it->w->buffer; |
| 5413 | it->area = TEXT_AREA; | 5413 | it->area = TEXT_AREA; |
| 5414 | it->multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 5414 | it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 5415 | it->sp = 0; | 5415 | it->sp = 0; |
| 5416 | it->string_from_display_prop_p = 0; | 5416 | it->string_from_display_prop_p = 0; |
| 5417 | it->face_before_selective_p = 0; | 5417 | it->face_before_selective_p = 0; |
| @@ -7919,7 +7919,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) | |||
| 7919 | old_deactivate_mark = Vdeactivate_mark; | 7919 | old_deactivate_mark = Vdeactivate_mark; |
| 7920 | oldbuf = current_buffer; | 7920 | oldbuf = current_buffer; |
| 7921 | Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); | 7921 | Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); |
| 7922 | B_ (current_buffer, undo_list) = Qt; | 7922 | BVAR (current_buffer, undo_list) = Qt; |
| 7923 | 7923 | ||
| 7924 | oldpoint = message_dolog_marker1; | 7924 | oldpoint = message_dolog_marker1; |
| 7925 | set_marker_restricted (oldpoint, make_number (PT), Qnil); | 7925 | set_marker_restricted (oldpoint, make_number (PT), Qnil); |
| @@ -7943,7 +7943,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) | |||
| 7943 | /* Insert the string--maybe converting multibyte to single byte | 7943 | /* Insert the string--maybe converting multibyte to single byte |
| 7944 | or vice versa, so that all the text fits the buffer. */ | 7944 | or vice versa, so that all the text fits the buffer. */ |
| 7945 | if (multibyte | 7945 | if (multibyte |
| 7946 | && NILP (B_ (current_buffer, enable_multibyte_characters))) | 7946 | && NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 7947 | { | 7947 | { |
| 7948 | EMACS_INT i; | 7948 | EMACS_INT i; |
| 7949 | int c, char_bytes; | 7949 | int c, char_bytes; |
| @@ -7961,7 +7961,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) | |||
| 7961 | } | 7961 | } |
| 7962 | } | 7962 | } |
| 7963 | else if (! multibyte | 7963 | else if (! multibyte |
| 7964 | && ! NILP (B_ (current_buffer, enable_multibyte_characters))) | 7964 | && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 7965 | { | 7965 | { |
| 7966 | EMACS_INT i; | 7966 | EMACS_INT i; |
| 7967 | int c, char_bytes; | 7967 | int c, char_bytes; |
| @@ -8460,7 +8460,7 @@ update_echo_area (void) | |||
| 8460 | Lisp_Object string; | 8460 | Lisp_Object string; |
| 8461 | string = Fcurrent_message (); | 8461 | string = Fcurrent_message (); |
| 8462 | message3 (string, SBYTES (string), | 8462 | message3 (string, SBYTES (string), |
| 8463 | !NILP (B_ (current_buffer, enable_multibyte_characters))); | 8463 | !NILP (BVAR (current_buffer, enable_multibyte_characters))); |
| 8464 | } | 8464 | } |
| 8465 | } | 8465 | } |
| 8466 | 8466 | ||
| @@ -8475,7 +8475,7 @@ ensure_echo_area_buffers (void) | |||
| 8475 | 8475 | ||
| 8476 | for (i = 0; i < 2; ++i) | 8476 | for (i = 0; i < 2; ++i) |
| 8477 | if (!BUFFERP (echo_buffer[i]) | 8477 | if (!BUFFERP (echo_buffer[i]) |
| 8478 | || NILP (B_ (XBUFFER (echo_buffer[i]), name))) | 8478 | || NILP (BVAR (XBUFFER (echo_buffer[i]), name))) |
| 8479 | { | 8479 | { |
| 8480 | char name[30]; | 8480 | char name[30]; |
| 8481 | Lisp_Object old_buffer; | 8481 | Lisp_Object old_buffer; |
| @@ -8484,7 +8484,7 @@ ensure_echo_area_buffers (void) | |||
| 8484 | old_buffer = echo_buffer[i]; | 8484 | old_buffer = echo_buffer[i]; |
| 8485 | sprintf (name, " *Echo Area %d*", i); | 8485 | sprintf (name, " *Echo Area %d*", i); |
| 8486 | echo_buffer[i] = Fget_buffer_create (build_string (name)); | 8486 | echo_buffer[i] = Fget_buffer_create (build_string (name)); |
| 8487 | B_ (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; | 8487 | BVAR (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; |
| 8488 | /* to force word wrap in echo area - | 8488 | /* to force word wrap in echo area - |
| 8489 | it was decided to postpone this*/ | 8489 | it was decided to postpone this*/ |
| 8490 | /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ | 8490 | /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ |
| @@ -8577,8 +8577,8 @@ with_echo_area_buffer (struct window *w, int which, | |||
| 8577 | set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); | 8577 | set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); |
| 8578 | } | 8578 | } |
| 8579 | 8579 | ||
| 8580 | B_ (current_buffer, undo_list) = Qt; | 8580 | BVAR (current_buffer, undo_list) = Qt; |
| 8581 | B_ (current_buffer, read_only) = Qnil; | 8581 | BVAR (current_buffer, read_only) = Qnil; |
| 8582 | specbind (Qinhibit_read_only, Qt); | 8582 | specbind (Qinhibit_read_only, Qt); |
| 8583 | specbind (Qinhibit_modification_hooks, Qt); | 8583 | specbind (Qinhibit_modification_hooks, Qt); |
| 8584 | 8584 | ||
| @@ -8691,7 +8691,7 @@ setup_echo_area_for_printing (int multibyte_p) | |||
| 8691 | 8691 | ||
| 8692 | /* Switch to that buffer and clear it. */ | 8692 | /* Switch to that buffer and clear it. */ |
| 8693 | set_buffer_internal (XBUFFER (echo_area_buffer[0])); | 8693 | set_buffer_internal (XBUFFER (echo_area_buffer[0])); |
| 8694 | B_ (current_buffer, truncate_lines) = Qnil; | 8694 | BVAR (current_buffer, truncate_lines) = Qnil; |
| 8695 | 8695 | ||
| 8696 | if (Z > BEG) | 8696 | if (Z > BEG) |
| 8697 | { | 8697 | { |
| @@ -8705,7 +8705,7 @@ setup_echo_area_for_printing (int multibyte_p) | |||
| 8705 | 8705 | ||
| 8706 | /* Set up the buffer for the multibyteness we need. */ | 8706 | /* Set up the buffer for the multibyteness we need. */ |
| 8707 | if (multibyte_p | 8707 | if (multibyte_p |
| 8708 | != !NILP (B_ (current_buffer, enable_multibyte_characters))) | 8708 | != !NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 8709 | Fset_buffer_multibyte (multibyte_p ? Qt : Qnil); | 8709 | Fset_buffer_multibyte (multibyte_p ? Qt : Qnil); |
| 8710 | 8710 | ||
| 8711 | /* Raise the frame containing the echo area. */ | 8711 | /* Raise the frame containing the echo area. */ |
| @@ -8734,7 +8734,7 @@ setup_echo_area_for_printing (int multibyte_p) | |||
| 8734 | { | 8734 | { |
| 8735 | /* Someone switched buffers between print requests. */ | 8735 | /* Someone switched buffers between print requests. */ |
| 8736 | set_buffer_internal (XBUFFER (echo_area_buffer[0])); | 8736 | set_buffer_internal (XBUFFER (echo_area_buffer[0])); |
| 8737 | B_ (current_buffer, truncate_lines) = Qnil; | 8737 | BVAR (current_buffer, truncate_lines) = Qnil; |
| 8738 | } | 8738 | } |
| 8739 | } | 8739 | } |
| 8740 | } | 8740 | } |
| @@ -9177,12 +9177,12 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby | |||
| 9177 | 9177 | ||
| 9178 | /* Change multibyteness of the echo buffer appropriately. */ | 9178 | /* Change multibyteness of the echo buffer appropriately. */ |
| 9179 | if (message_enable_multibyte | 9179 | if (message_enable_multibyte |
| 9180 | != !NILP (B_ (current_buffer, enable_multibyte_characters))) | 9180 | != !NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 9181 | Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); | 9181 | Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); |
| 9182 | 9182 | ||
| 9183 | B_ (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; | 9183 | BVAR (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; |
| 9184 | if (!NILP (B_ (current_buffer, bidi_display_reordering))) | 9184 | if (!NILP (BVAR (current_buffer, bidi_display_reordering))) |
| 9185 | B_ (current_buffer, bidi_paragraph_direction) = Qleft_to_right; | 9185 | BVAR (current_buffer, bidi_paragraph_direction) = Qleft_to_right; |
| 9186 | 9186 | ||
| 9187 | /* Insert new message at BEG. */ | 9187 | /* Insert new message at BEG. */ |
| 9188 | TEMP_SET_PT_BOTH (BEG, BEG_BYTE); | 9188 | 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 | |||
| 9205 | if (nbytes == 0) | 9205 | if (nbytes == 0) |
| 9206 | nbytes = strlen (s); | 9206 | nbytes = strlen (s); |
| 9207 | 9207 | ||
| 9208 | if (multibyte_p && NILP (B_ (current_buffer, enable_multibyte_characters))) | 9208 | if (multibyte_p && NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 9209 | { | 9209 | { |
| 9210 | /* Convert from multi-byte to single-byte. */ | 9210 | /* Convert from multi-byte to single-byte. */ |
| 9211 | EMACS_INT i; | 9211 | EMACS_INT i; |
| @@ -9223,7 +9223,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby | |||
| 9223 | } | 9223 | } |
| 9224 | } | 9224 | } |
| 9225 | else if (!multibyte_p | 9225 | else if (!multibyte_p |
| 9226 | && !NILP (B_ (current_buffer, enable_multibyte_characters))) | 9226 | && !NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 9227 | { | 9227 | { |
| 9228 | /* Convert from single-byte to multi-byte. */ | 9228 | /* Convert from single-byte to multi-byte. */ |
| 9229 | EMACS_INT i; | 9229 | EMACS_INT i; |
| @@ -9808,7 +9808,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) | |||
| 9808 | < BUF_MODIFF (XBUFFER (w->buffer))) | 9808 | < BUF_MODIFF (XBUFFER (w->buffer))) |
| 9809 | != !NILP (w->last_had_star)) | 9809 | != !NILP (w->last_had_star)) |
| 9810 | || ((!NILP (Vtransient_mark_mode) | 9810 | || ((!NILP (Vtransient_mark_mode) |
| 9811 | && !NILP (B_ (XBUFFER (w->buffer), mark_active))) | 9811 | && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) |
| 9812 | != !NILP (w->region_showing))) | 9812 | != !NILP (w->region_showing))) |
| 9813 | { | 9813 | { |
| 9814 | struct buffer *prev = current_buffer; | 9814 | struct buffer *prev = current_buffer; |
| @@ -10006,7 +10006,7 @@ update_tool_bar (struct frame *f, int save_match_data) | |||
| 10006 | < BUF_MODIFF (XBUFFER (w->buffer))) | 10006 | < BUF_MODIFF (XBUFFER (w->buffer))) |
| 10007 | != !NILP (w->last_had_star)) | 10007 | != !NILP (w->last_had_star)) |
| 10008 | || ((!NILP (Vtransient_mark_mode) | 10008 | || ((!NILP (Vtransient_mark_mode) |
| 10009 | && !NILP (B_ (XBUFFER (w->buffer), mark_active))) | 10009 | && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) |
| 10010 | != !NILP (w->region_showing))) | 10010 | != !NILP (w->region_showing))) |
| 10011 | { | 10011 | { |
| 10012 | struct buffer *prev = current_buffer; | 10012 | struct buffer *prev = current_buffer; |
| @@ -11097,8 +11097,8 @@ text_outside_line_unchanged_p (struct window *w, | |||
| 11097 | /* If selective display, can't optimize if changes start at the | 11097 | /* If selective display, can't optimize if changes start at the |
| 11098 | beginning of the line. */ | 11098 | beginning of the line. */ |
| 11099 | if (unchanged_p | 11099 | if (unchanged_p |
| 11100 | && INTEGERP (B_ (current_buffer, selective_display)) | 11100 | && INTEGERP (BVAR (current_buffer, selective_display)) |
| 11101 | && XINT (B_ (current_buffer, selective_display)) > 0 | 11101 | && XINT (BVAR (current_buffer, selective_display)) > 0 |
| 11102 | && (BEG_UNCHANGED < start || GPT <= start)) | 11102 | && (BEG_UNCHANGED < start || GPT <= start)) |
| 11103 | unchanged_p = 0; | 11103 | unchanged_p = 0; |
| 11104 | 11104 | ||
| @@ -11126,8 +11126,8 @@ text_outside_line_unchanged_p (struct window *w, | |||
| 11126 | require to redisplay the whole paragraph. It might be worthwhile | 11126 | require to redisplay the whole paragraph. It might be worthwhile |
| 11127 | to find the paragraph limits and widen the range of redisplayed | 11127 | to find the paragraph limits and widen the range of redisplayed |
| 11128 | lines to that, but for now just give up this optimization. */ | 11128 | lines to that, but for now just give up this optimization. */ |
| 11129 | if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) | 11129 | if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) |
| 11130 | && NILP (B_ (XBUFFER (w->buffer), bidi_paragraph_direction))) | 11130 | && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) |
| 11131 | unchanged_p = 0; | 11131 | unchanged_p = 0; |
| 11132 | } | 11132 | } |
| 11133 | 11133 | ||
| @@ -11419,6 +11419,7 @@ static void | |||
| 11419 | redisplay_internal (int preserve_echo_area) | 11419 | redisplay_internal (int preserve_echo_area) |
| 11420 | { | 11420 | { |
| 11421 | struct window *w = XWINDOW (selected_window); | 11421 | struct window *w = XWINDOW (selected_window); |
| 11422 | struct window *sw; | ||
| 11422 | struct frame *f; | 11423 | struct frame *f; |
| 11423 | int pause; | 11424 | int pause; |
| 11424 | int must_finish = 0; | 11425 | int must_finish = 0; |
| @@ -11479,6 +11480,9 @@ redisplay_internal (int preserve_echo_area) | |||
| 11479 | } | 11480 | } |
| 11480 | 11481 | ||
| 11481 | retry: | 11482 | retry: |
| 11483 | /* Remember the currently selected window. */ | ||
| 11484 | sw = w; | ||
| 11485 | |||
| 11482 | if (!EQ (old_frame, selected_frame) | 11486 | if (!EQ (old_frame, selected_frame) |
| 11483 | && FRAME_LIVE_P (XFRAME (old_frame))) | 11487 | && FRAME_LIVE_P (XFRAME (old_frame))) |
| 11484 | /* When running redisplay, we play a bit fast-and-loose and allow e.g. | 11488 | /* When running redisplay, we play a bit fast-and-loose and allow e.g. |
| @@ -11546,6 +11550,14 @@ redisplay_internal (int preserve_echo_area) | |||
| 11546 | /* Notice any pending interrupt request to change frame size. */ | 11550 | /* Notice any pending interrupt request to change frame size. */ |
| 11547 | do_pending_window_change (1); | 11551 | do_pending_window_change (1); |
| 11548 | 11552 | ||
| 11553 | /* do_pending_window_change could change the selected_window due to | ||
| 11554 | frame resizing which makes the selected window too small. */ | ||
| 11555 | if (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw) | ||
| 11556 | { | ||
| 11557 | sw = w; | ||
| 11558 | reconsider_clip_changes (w, current_buffer); | ||
| 11559 | } | ||
| 11560 | |||
| 11549 | /* Clear frames marked as garbaged. */ | 11561 | /* Clear frames marked as garbaged. */ |
| 11550 | if (frame_garbaged) | 11562 | if (frame_garbaged) |
| 11551 | clear_garbaged_frames (); | 11563 | clear_garbaged_frames (); |
| @@ -11662,11 +11674,11 @@ redisplay_internal (int preserve_echo_area) | |||
| 11662 | the whole window. The assignment to this_line_start_pos prevents | 11674 | the whole window. The assignment to this_line_start_pos prevents |
| 11663 | the optimization directly below this if-statement. */ | 11675 | the optimization directly below this if-statement. */ |
| 11664 | if (((!NILP (Vtransient_mark_mode) | 11676 | if (((!NILP (Vtransient_mark_mode) |
| 11665 | && !NILP (B_ (XBUFFER (w->buffer), mark_active))) | 11677 | && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) |
| 11666 | != !NILP (w->region_showing)) | 11678 | != !NILP (w->region_showing)) |
| 11667 | || (!NILP (w->region_showing) | 11679 | || (!NILP (w->region_showing) |
| 11668 | && !EQ (w->region_showing, | 11680 | && !EQ (w->region_showing, |
| 11669 | Fmarker_position (B_ (XBUFFER (w->buffer), mark))))) | 11681 | Fmarker_position (BVAR (XBUFFER (w->buffer), mark))))) |
| 11670 | CHARPOS (this_line_start_pos) = 0; | 11682 | CHARPOS (this_line_start_pos) = 0; |
| 11671 | 11683 | ||
| 11672 | /* Optimize the case that only the line containing the cursor in the | 11684 | /* Optimize the case that only the line containing the cursor in the |
| @@ -11815,6 +11827,10 @@ redisplay_internal (int preserve_echo_area) | |||
| 11815 | if (!must_finish) | 11827 | if (!must_finish) |
| 11816 | { | 11828 | { |
| 11817 | do_pending_window_change (1); | 11829 | do_pending_window_change (1); |
| 11830 | /* If selected_window changed, redisplay again. */ | ||
| 11831 | if (WINDOWP (selected_window) | ||
| 11832 | && (w = XWINDOW (selected_window)) != sw) | ||
| 11833 | goto retry; | ||
| 11818 | 11834 | ||
| 11819 | /* We used to always goto end_of_redisplay here, but this | 11835 | /* We used to always goto end_of_redisplay here, but this |
| 11820 | isn't enough if we have a blinking cursor. */ | 11836 | isn't enough if we have a blinking cursor. */ |
| @@ -11826,8 +11842,8 @@ redisplay_internal (int preserve_echo_area) | |||
| 11826 | /* If highlighting the region, or if the cursor is in the echo area, | 11842 | /* If highlighting the region, or if the cursor is in the echo area, |
| 11827 | then we can't just move the cursor. */ | 11843 | then we can't just move the cursor. */ |
| 11828 | else if (! (!NILP (Vtransient_mark_mode) | 11844 | else if (! (!NILP (Vtransient_mark_mode) |
| 11829 | && !NILP (B_ (current_buffer, mark_active))) | 11845 | && !NILP (BVAR (current_buffer, mark_active))) |
| 11830 | && (EQ (selected_window, B_ (current_buffer, last_selected_window)) | 11846 | && (EQ (selected_window, BVAR (current_buffer, last_selected_window)) |
| 11831 | || highlight_nonselected_windows) | 11847 | || highlight_nonselected_windows) |
| 11832 | && NILP (w->region_showing) | 11848 | && NILP (w->region_showing) |
| 11833 | && NILP (Vshow_trailing_whitespace) | 11849 | && NILP (Vshow_trailing_whitespace) |
| @@ -12109,8 +12125,9 @@ redisplay_internal (int preserve_echo_area) | |||
| 12109 | do_pending_window_change (1); | 12125 | do_pending_window_change (1); |
| 12110 | 12126 | ||
| 12111 | /* If we just did a pending size change, or have additional | 12127 | /* If we just did a pending size change, or have additional |
| 12112 | visible frames, redisplay again. */ | 12128 | visible frames, or selected_window changed, redisplay again. */ |
| 12113 | if (windows_or_buffers_changed && !pause) | 12129 | if ((windows_or_buffers_changed && !pause) |
| 12130 | || (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw)) | ||
| 12114 | goto retry; | 12131 | goto retry; |
| 12115 | 12132 | ||
| 12116 | /* Clear the face and image caches. | 12133 | /* Clear the face and image caches. |
| @@ -13033,8 +13050,8 @@ try_scrolling (Lisp_Object window, int just_this_one_p, | |||
| 13033 | scroll_max = (max (scroll_step, | 13050 | scroll_max = (max (scroll_step, |
| 13034 | max (arg_scroll_conservatively, temp_scroll_step)) | 13051 | max (arg_scroll_conservatively, temp_scroll_step)) |
| 13035 | * FRAME_LINE_HEIGHT (f)); | 13052 | * FRAME_LINE_HEIGHT (f)); |
| 13036 | else if (NUMBERP (B_ (current_buffer, scroll_down_aggressively)) | 13053 | else if (NUMBERP (BVAR (current_buffer, scroll_down_aggressively)) |
| 13037 | || NUMBERP (B_ (current_buffer, scroll_up_aggressively))) | 13054 | || NUMBERP (BVAR (current_buffer, scroll_up_aggressively))) |
| 13038 | /* We're trying to scroll because of aggressive scrolling but no | 13055 | /* We're trying to scroll because of aggressive scrolling but no |
| 13039 | scroll_step is set. Choose an arbitrary one. */ | 13056 | scroll_step is set. Choose an arbitrary one. */ |
| 13040 | scroll_max = 10 * FRAME_LINE_HEIGHT (f); | 13057 | scroll_max = 10 * FRAME_LINE_HEIGHT (f); |
| @@ -13099,7 +13116,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, | |||
| 13099 | amount_to_scroll = scroll_max; | 13116 | amount_to_scroll = scroll_max; |
| 13100 | else | 13117 | else |
| 13101 | { | 13118 | { |
| 13102 | aggressive = B_ (current_buffer, scroll_up_aggressively); | 13119 | aggressive = BVAR (current_buffer, scroll_up_aggressively); |
| 13103 | height = WINDOW_BOX_TEXT_HEIGHT (w); | 13120 | height = WINDOW_BOX_TEXT_HEIGHT (w); |
| 13104 | if (NUMBERP (aggressive)) | 13121 | if (NUMBERP (aggressive)) |
| 13105 | { | 13122 | { |
| @@ -13182,7 +13199,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, | |||
| 13182 | amount_to_scroll = scroll_max; | 13199 | amount_to_scroll = scroll_max; |
| 13183 | else | 13200 | else |
| 13184 | { | 13201 | { |
| 13185 | aggressive = B_ (current_buffer, scroll_down_aggressively); | 13202 | aggressive = BVAR (current_buffer, scroll_down_aggressively); |
| 13186 | height = WINDOW_BOX_TEXT_HEIGHT (w); | 13203 | height = WINDOW_BOX_TEXT_HEIGHT (w); |
| 13187 | if (NUMBERP (aggressive)) | 13204 | if (NUMBERP (aggressive)) |
| 13188 | { | 13205 | { |
| @@ -13363,7 +13380,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste | |||
| 13363 | region exists, cursor movement has to do more than just | 13380 | region exists, cursor movement has to do more than just |
| 13364 | set the cursor. */ | 13381 | set the cursor. */ |
| 13365 | && !(!NILP (Vtransient_mark_mode) | 13382 | && !(!NILP (Vtransient_mark_mode) |
| 13366 | && !NILP (B_ (current_buffer, mark_active))) | 13383 | && !NILP (BVAR (current_buffer, mark_active))) |
| 13367 | && NILP (w->region_showing) | 13384 | && NILP (w->region_showing) |
| 13368 | && NILP (Vshow_trailing_whitespace) | 13385 | && NILP (Vshow_trailing_whitespace) |
| 13369 | /* Right after splitting windows, last_point may be nil. */ | 13386 | /* Right after splitting windows, last_point may be nil. */ |
| @@ -13518,7 +13535,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste | |||
| 13518 | must_scroll = 1; | 13535 | must_scroll = 1; |
| 13519 | } | 13536 | } |
| 13520 | else if (rc != CURSOR_MOVEMENT_SUCCESS | 13537 | else if (rc != CURSOR_MOVEMENT_SUCCESS |
| 13521 | && !NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) | 13538 | && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) |
| 13522 | { | 13539 | { |
| 13523 | /* If rows are bidi-reordered and point moved, back up | 13540 | /* If rows are bidi-reordered and point moved, back up |
| 13524 | until we find a row that does not belong to a | 13541 | until we find a row that does not belong to a |
| @@ -13576,7 +13593,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste | |||
| 13576 | else if (scroll_p) | 13593 | else if (scroll_p) |
| 13577 | rc = CURSOR_MOVEMENT_MUST_SCROLL; | 13594 | rc = CURSOR_MOVEMENT_MUST_SCROLL; |
| 13578 | else if (rc != CURSOR_MOVEMENT_SUCCESS | 13595 | else if (rc != CURSOR_MOVEMENT_SUCCESS |
| 13579 | && !NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) | 13596 | && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) |
| 13580 | { | 13597 | { |
| 13581 | /* With bidi-reordered rows, there could be more than | 13598 | /* With bidi-reordered rows, there could be more than |
| 13582 | one candidate row whose start and end positions | 13599 | one candidate row whose start and end positions |
| @@ -13876,7 +13893,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 13876 | struct Lisp_Char_Table *disptab = buffer_display_table (); | 13893 | struct Lisp_Char_Table *disptab = buffer_display_table (); |
| 13877 | 13894 | ||
| 13878 | if (! disptab_matches_widthtab (disptab, | 13895 | if (! disptab_matches_widthtab (disptab, |
| 13879 | XVECTOR (B_ (current_buffer, width_table)))) | 13896 | XVECTOR (BVAR (current_buffer, width_table)))) |
| 13880 | { | 13897 | { |
| 13881 | invalidate_region_cache (current_buffer, | 13898 | invalidate_region_cache (current_buffer, |
| 13882 | current_buffer->width_run_cache, | 13899 | current_buffer->width_run_cache, |
| @@ -13998,7 +14015,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 13998 | /* If we are highlighting the region, then we just changed | 14015 | /* If we are highlighting the region, then we just changed |
| 13999 | the region, so redisplay to show it. */ | 14016 | the region, so redisplay to show it. */ |
| 14000 | if (!NILP (Vtransient_mark_mode) | 14017 | if (!NILP (Vtransient_mark_mode) |
| 14001 | && !NILP (B_ (current_buffer, mark_active))) | 14018 | && !NILP (BVAR (current_buffer, mark_active))) |
| 14002 | { | 14019 | { |
| 14003 | clear_glyph_matrix (w->desired_matrix); | 14020 | clear_glyph_matrix (w->desired_matrix); |
| 14004 | if (!try_window (window, startp, 0)) | 14021 | if (!try_window (window, startp, 0)) |
| @@ -14161,8 +14178,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 14161 | if ((scroll_conservatively | 14178 | if ((scroll_conservatively |
| 14162 | || emacs_scroll_step | 14179 | || emacs_scroll_step |
| 14163 | || temp_scroll_step | 14180 | || temp_scroll_step |
| 14164 | || NUMBERP (B_ (current_buffer, scroll_up_aggressively)) | 14181 | || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) |
| 14165 | || NUMBERP (B_ (current_buffer, scroll_down_aggressively))) | 14182 | || NUMBERP (BVAR (current_buffer, scroll_down_aggressively))) |
| 14166 | && !current_buffer->clip_changed | 14183 | && !current_buffer->clip_changed |
| 14167 | && CHARPOS (startp) >= BEGV | 14184 | && CHARPOS (startp) >= BEGV |
| 14168 | && CHARPOS (startp) <= ZV) | 14185 | && CHARPOS (startp) <= ZV) |
| @@ -14605,7 +14622,7 @@ try_window_reusing_current_matrix (struct window *w) | |||
| 14605 | 14622 | ||
| 14606 | /* Can't do this if region may have changed. */ | 14623 | /* Can't do this if region may have changed. */ |
| 14607 | if ((!NILP (Vtransient_mark_mode) | 14624 | if ((!NILP (Vtransient_mark_mode) |
| 14608 | && !NILP (B_ (current_buffer, mark_active))) | 14625 | && !NILP (BVAR (current_buffer, mark_active))) |
| 14609 | || !NILP (w->region_showing) | 14626 | || !NILP (w->region_showing) |
| 14610 | || !NILP (Vshow_trailing_whitespace)) | 14627 | || !NILP (Vshow_trailing_whitespace)) |
| 14611 | return 0; | 14628 | return 0; |
| @@ -14948,7 +14965,7 @@ try_window_reusing_current_matrix (struct window *w) | |||
| 14948 | 14965 | ||
| 14949 | /* Can't use this optimization with bidi-reordered glyph | 14966 | /* Can't use this optimization with bidi-reordered glyph |
| 14950 | rows, unless cursor is already at point. */ | 14967 | rows, unless cursor is already at point. */ |
| 14951 | if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) | 14968 | if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) |
| 14952 | { | 14969 | { |
| 14953 | if (!(w->cursor.hpos >= 0 | 14970 | if (!(w->cursor.hpos >= 0 |
| 14954 | && w->cursor.hpos < row->used[TEXT_AREA] | 14971 | && w->cursor.hpos < row->used[TEXT_AREA] |
| @@ -15262,7 +15279,7 @@ row_containing_pos (struct window *w, EMACS_INT charpos, | |||
| 15262 | { | 15279 | { |
| 15263 | struct glyph *g; | 15280 | struct glyph *g; |
| 15264 | 15281 | ||
| 15265 | if (NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) | 15282 | if (NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) |
| 15266 | || (!best_row && !row->continued_p)) | 15283 | || (!best_row && !row->continued_p)) |
| 15267 | return row; | 15284 | return row; |
| 15268 | /* In bidi-reordered rows, there could be several rows | 15285 | /* In bidi-reordered rows, there could be several rows |
| @@ -15409,7 +15426,7 @@ try_window_id (struct window *w) | |||
| 15409 | /* Can't use this if highlighting a region because a cursor movement | 15426 | /* Can't use this if highlighting a region because a cursor movement |
| 15410 | will do more than just set the cursor. */ | 15427 | will do more than just set the cursor. */ |
| 15411 | if (!NILP (Vtransient_mark_mode) | 15428 | if (!NILP (Vtransient_mark_mode) |
| 15412 | && !NILP (B_ (current_buffer, mark_active))) | 15429 | && !NILP (BVAR (current_buffer, mark_active))) |
| 15413 | GIVE_UP (9); | 15430 | GIVE_UP (9); |
| 15414 | 15431 | ||
| 15415 | /* Likewise if highlighting trailing whitespace. */ | 15432 | /* Likewise if highlighting trailing whitespace. */ |
| @@ -15429,7 +15446,7 @@ try_window_id (struct window *w) | |||
| 15429 | wrapped line can change the wrap position, altering the line | 15446 | wrapped line can change the wrap position, altering the line |
| 15430 | above it. It might be worthwhile to handle this more | 15447 | above it. It might be worthwhile to handle this more |
| 15431 | intelligently, but for now just redisplay from scratch. */ | 15448 | intelligently, but for now just redisplay from scratch. */ |
| 15432 | if (!NILP (B_ (XBUFFER (w->buffer), word_wrap))) | 15449 | if (!NILP (BVAR (XBUFFER (w->buffer), word_wrap))) |
| 15433 | GIVE_UP (21); | 15450 | GIVE_UP (21); |
| 15434 | 15451 | ||
| 15435 | /* Under bidi reordering, adding or deleting a character in the | 15452 | /* Under bidi reordering, adding or deleting a character in the |
| @@ -15440,8 +15457,8 @@ try_window_id (struct window *w) | |||
| 15440 | to find the paragraph limits and widen the range of redisplayed | 15457 | to find the paragraph limits and widen the range of redisplayed |
| 15441 | lines to that, but for now just give up this optimization and | 15458 | lines to that, but for now just give up this optimization and |
| 15442 | redisplay from scratch. */ | 15459 | redisplay from scratch. */ |
| 15443 | if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) | 15460 | if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) |
| 15444 | && NILP (B_ (XBUFFER (w->buffer), bidi_paragraph_direction))) | 15461 | && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) |
| 15445 | GIVE_UP (22); | 15462 | GIVE_UP (22); |
| 15446 | 15463 | ||
| 15447 | /* Make sure beg_unchanged and end_unchanged are up to date. Do it | 15464 | /* Make sure beg_unchanged and end_unchanged are up to date. Do it |
| @@ -16412,7 +16429,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) | |||
| 16412 | it.glyph_row->used[TEXT_AREA] = 0; | 16429 | it.glyph_row->used[TEXT_AREA] = 0; |
| 16413 | SET_TEXT_POS (it.position, 0, 0); | 16430 | SET_TEXT_POS (it.position, 0, 0); |
| 16414 | 16431 | ||
| 16415 | multibyte_p = !NILP (B_ (buffer, enable_multibyte_characters)); | 16432 | multibyte_p = !NILP (BVAR (buffer, enable_multibyte_characters)); |
| 16416 | p = arrow_string; | 16433 | p = arrow_string; |
| 16417 | while (p < arrow_end) | 16434 | while (p < arrow_end) |
| 16418 | { | 16435 | { |
| @@ -17347,7 +17364,7 @@ display_line (struct it *it) | |||
| 17347 | row->glyphs[TEXT_AREA]->charpos = -1; | 17364 | row->glyphs[TEXT_AREA]->charpos = -1; |
| 17348 | row->displays_text_p = 0; | 17365 | row->displays_text_p = 0; |
| 17349 | 17366 | ||
| 17350 | if (!NILP (B_ (XBUFFER (it->w->buffer), indicate_empty_lines)) | 17367 | if (!NILP (BVAR (XBUFFER (it->w->buffer), indicate_empty_lines)) |
| 17351 | && (!MINI_WINDOW_P (it->w) | 17368 | && (!MINI_WINDOW_P (it->w) |
| 17352 | || (minibuf_level && EQ (it->window, minibuf_window)))) | 17369 | || (minibuf_level && EQ (it->window, minibuf_window)))) |
| 17353 | row->indicate_empty_line_p = 1; | 17370 | row->indicate_empty_line_p = 1; |
| @@ -17925,10 +17942,10 @@ See also `bidi-paragraph-direction'. */) | |||
| 17925 | old = current_buffer; | 17942 | old = current_buffer; |
| 17926 | } | 17943 | } |
| 17927 | 17944 | ||
| 17928 | if (NILP (B_ (buf, bidi_display_reordering))) | 17945 | if (NILP (BVAR (buf, bidi_display_reordering))) |
| 17929 | return Qleft_to_right; | 17946 | return Qleft_to_right; |
| 17930 | else if (!NILP (B_ (buf, bidi_paragraph_direction))) | 17947 | else if (!NILP (BVAR (buf, bidi_paragraph_direction))) |
| 17931 | return B_ (buf, bidi_paragraph_direction); | 17948 | return BVAR (buf, bidi_paragraph_direction); |
| 17932 | else | 17949 | else |
| 17933 | { | 17950 | { |
| 17934 | /* Determine the direction from buffer text. We could try to | 17951 | /* Determine the direction from buffer text. We could try to |
| @@ -18187,14 +18204,14 @@ display_mode_lines (struct window *w) | |||
| 18187 | 18204 | ||
| 18188 | /* Select mode line face based on the real selected window. */ | 18205 | /* Select mode line face based on the real selected window. */ |
| 18189 | display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), | 18206 | display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), |
| 18190 | B_ (current_buffer, mode_line_format)); | 18207 | BVAR (current_buffer, mode_line_format)); |
| 18191 | ++n; | 18208 | ++n; |
| 18192 | } | 18209 | } |
| 18193 | 18210 | ||
| 18194 | if (WINDOW_WANTS_HEADER_LINE_P (w)) | 18211 | if (WINDOW_WANTS_HEADER_LINE_P (w)) |
| 18195 | { | 18212 | { |
| 18196 | display_mode_line (w, HEADER_LINE_FACE_ID, | 18213 | display_mode_line (w, HEADER_LINE_FACE_ID, |
| 18197 | B_ (current_buffer, header_line_format)); | 18214 | BVAR (current_buffer, header_line_format)); |
| 18198 | ++n; | 18215 | ++n; |
| 18199 | } | 18216 | } |
| 18200 | 18217 | ||
| @@ -19129,7 +19146,7 @@ static char * | |||
| 19129 | decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_flag) | 19146 | decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_flag) |
| 19130 | { | 19147 | { |
| 19131 | Lisp_Object val; | 19148 | Lisp_Object val; |
| 19132 | int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); | 19149 | int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); |
| 19133 | const unsigned char *eol_str; | 19150 | const unsigned char *eol_str; |
| 19134 | int eol_str_len; | 19151 | int eol_str_len; |
| 19135 | /* The EOL conversion we are using. */ | 19152 | /* The EOL conversion we are using. */ |
| @@ -19225,7 +19242,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19225 | switch (c) | 19242 | switch (c) |
| 19226 | { | 19243 | { |
| 19227 | case '*': | 19244 | case '*': |
| 19228 | if (!NILP (B_ (b, read_only))) | 19245 | if (!NILP (BVAR (b, read_only))) |
| 19229 | return "%"; | 19246 | return "%"; |
| 19230 | if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) | 19247 | if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) |
| 19231 | return "*"; | 19248 | return "*"; |
| @@ -19235,7 +19252,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19235 | /* This differs from %* only for a modified read-only buffer. */ | 19252 | /* This differs from %* only for a modified read-only buffer. */ |
| 19236 | if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) | 19253 | if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) |
| 19237 | return "*"; | 19254 | return "*"; |
| 19238 | if (!NILP (B_ (b, read_only))) | 19255 | if (!NILP (BVAR (b, read_only))) |
| 19239 | return "%"; | 19256 | return "%"; |
| 19240 | return "-"; | 19257 | return "-"; |
| 19241 | 19258 | ||
| @@ -19297,7 +19314,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19297 | } | 19314 | } |
| 19298 | 19315 | ||
| 19299 | case 'b': | 19316 | case 'b': |
| 19300 | obj = B_ (b, name); | 19317 | obj = BVAR (b, name); |
| 19301 | break; | 19318 | break; |
| 19302 | 19319 | ||
| 19303 | case 'c': | 19320 | case 'c': |
| @@ -19337,7 +19354,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19337 | return "Emacs"; | 19354 | return "Emacs"; |
| 19338 | 19355 | ||
| 19339 | case 'f': | 19356 | case 'f': |
| 19340 | obj = B_ (b, filename); | 19357 | obj = BVAR (b, filename); |
| 19341 | break; | 19358 | break; |
| 19342 | 19359 | ||
| 19343 | case 'i': | 19360 | case 'i': |
| @@ -19473,7 +19490,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19473 | break; | 19490 | break; |
| 19474 | 19491 | ||
| 19475 | case 'm': | 19492 | case 'm': |
| 19476 | obj = B_ (b, mode_name); | 19493 | obj = BVAR (b, mode_name); |
| 19477 | break; | 19494 | break; |
| 19478 | 19495 | ||
| 19479 | case 'n': | 19496 | case 'n': |
| @@ -19558,7 +19575,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19558 | { | 19575 | { |
| 19559 | int count = inhibit_garbage_collection (); | 19576 | int count = inhibit_garbage_collection (); |
| 19560 | Lisp_Object val = call1 (intern ("file-remote-p"), | 19577 | Lisp_Object val = call1 (intern ("file-remote-p"), |
| 19561 | B_ (current_buffer, directory)); | 19578 | BVAR (current_buffer, directory)); |
| 19562 | unbind_to (count, Qnil); | 19579 | unbind_to (count, Qnil); |
| 19563 | 19580 | ||
| 19564 | if (NILP (val)) | 19581 | if (NILP (val)) |
| @@ -19568,11 +19585,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19568 | } | 19585 | } |
| 19569 | 19586 | ||
| 19570 | case 't': /* indicate TEXT or BINARY */ | 19587 | case 't': /* indicate TEXT or BINARY */ |
| 19571 | #ifdef MODE_LINE_BINARY_TEXT | ||
| 19572 | return MODE_LINE_BINARY_TEXT (b); | ||
| 19573 | #else | ||
| 19574 | return "T"; | 19588 | return "T"; |
| 19575 | #endif | ||
| 19576 | 19589 | ||
| 19577 | case 'z': | 19590 | case 'z': |
| 19578 | /* coding-system (not including end-of-line format) */ | 19591 | /* coding-system (not including end-of-line format) */ |
| @@ -19593,7 +19606,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, | |||
| 19593 | (FRAME_TERMINAL_CODING (f)->id), | 19606 | (FRAME_TERMINAL_CODING (f)->id), |
| 19594 | p, 0); | 19607 | p, 0); |
| 19595 | } | 19608 | } |
| 19596 | p = decode_mode_spec_coding (B_ (b, buffer_file_coding_system), | 19609 | p = decode_mode_spec_coding (BVAR (b, buffer_file_coding_system), |
| 19597 | p, eol_flag); | 19610 | p, eol_flag); |
| 19598 | 19611 | ||
| 19599 | #if 0 /* This proves to be annoying; I think we can do without. -- rms. */ | 19612 | #if 0 /* This proves to be annoying; I think we can do without. -- rms. */ |
| @@ -19643,8 +19656,8 @@ display_count_lines (EMACS_INT start, EMACS_INT start_byte, | |||
| 19643 | 19656 | ||
| 19644 | /* If we are not in selective display mode, | 19657 | /* If we are not in selective display mode, |
| 19645 | check only for newlines. */ | 19658 | check only for newlines. */ |
| 19646 | int selective_display = (!NILP (B_ (current_buffer, selective_display)) | 19659 | int selective_display = (!NILP (BVAR (current_buffer, selective_display)) |
| 19647 | && !INTEGERP (B_ (current_buffer, selective_display))); | 19660 | && !INTEGERP (BVAR (current_buffer, selective_display))); |
| 19648 | 19661 | ||
| 19649 | if (count > 0) | 19662 | if (count > 0) |
| 19650 | { | 19663 | { |
| @@ -23291,13 +23304,13 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, | |||
| 23291 | { | 23304 | { |
| 23292 | if (w == XWINDOW (echo_area_window)) | 23305 | if (w == XWINDOW (echo_area_window)) |
| 23293 | { | 23306 | { |
| 23294 | if (EQ (B_ (b, cursor_type), Qt) || NILP (B_ (b, cursor_type))) | 23307 | if (EQ (BVAR (b, cursor_type), Qt) || NILP (BVAR (b, cursor_type))) |
| 23295 | { | 23308 | { |
| 23296 | *width = FRAME_CURSOR_WIDTH (f); | 23309 | *width = FRAME_CURSOR_WIDTH (f); |
| 23297 | return FRAME_DESIRED_CURSOR (f); | 23310 | return FRAME_DESIRED_CURSOR (f); |
| 23298 | } | 23311 | } |
| 23299 | else | 23312 | else |
| 23300 | return get_specified_cursor_type (B_ (b, cursor_type), width); | 23313 | return get_specified_cursor_type (BVAR (b, cursor_type), width); |
| 23301 | } | 23314 | } |
| 23302 | 23315 | ||
| 23303 | *active_cursor = 0; | 23316 | *active_cursor = 0; |
| @@ -23317,23 +23330,23 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, | |||
| 23317 | } | 23330 | } |
| 23318 | 23331 | ||
| 23319 | /* Never display a cursor in a window in which cursor-type is nil. */ | 23332 | /* Never display a cursor in a window in which cursor-type is nil. */ |
| 23320 | if (NILP (B_ (b, cursor_type))) | 23333 | if (NILP (BVAR (b, cursor_type))) |
| 23321 | return NO_CURSOR; | 23334 | return NO_CURSOR; |
| 23322 | 23335 | ||
| 23323 | /* Get the normal cursor type for this window. */ | 23336 | /* Get the normal cursor type for this window. */ |
| 23324 | if (EQ (B_ (b, cursor_type), Qt)) | 23337 | if (EQ (BVAR (b, cursor_type), Qt)) |
| 23325 | { | 23338 | { |
| 23326 | cursor_type = FRAME_DESIRED_CURSOR (f); | 23339 | cursor_type = FRAME_DESIRED_CURSOR (f); |
| 23327 | *width = FRAME_CURSOR_WIDTH (f); | 23340 | *width = FRAME_CURSOR_WIDTH (f); |
| 23328 | } | 23341 | } |
| 23329 | else | 23342 | else |
| 23330 | cursor_type = get_specified_cursor_type (B_ (b, cursor_type), width); | 23343 | cursor_type = get_specified_cursor_type (BVAR (b, cursor_type), width); |
| 23331 | 23344 | ||
| 23332 | /* Use cursor-in-non-selected-windows instead | 23345 | /* Use cursor-in-non-selected-windows instead |
| 23333 | for non-selected window or frame. */ | 23346 | for non-selected window or frame. */ |
| 23334 | if (non_selected) | 23347 | if (non_selected) |
| 23335 | { | 23348 | { |
| 23336 | alt_cursor = B_ (b, cursor_in_non_selected_windows); | 23349 | alt_cursor = BVAR (b, cursor_in_non_selected_windows); |
| 23337 | if (!EQ (Qt, alt_cursor)) | 23350 | if (!EQ (Qt, alt_cursor)) |
| 23338 | return get_specified_cursor_type (alt_cursor, width); | 23351 | return get_specified_cursor_type (alt_cursor, width); |
| 23339 | /* t means modify the normal cursor type. */ | 23352 | /* t means modify the normal cursor type. */ |
| @@ -23380,7 +23393,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, | |||
| 23380 | /* Cursor is blinked off, so determine how to "toggle" it. */ | 23393 | /* Cursor is blinked off, so determine how to "toggle" it. */ |
| 23381 | 23394 | ||
| 23382 | /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ | 23395 | /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ |
| 23383 | if ((alt_cursor = Fassoc (B_ (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) | 23396 | if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) |
| 23384 | return get_specified_cursor_type (XCDR (alt_cursor), width); | 23397 | return get_specified_cursor_type (XCDR (alt_cursor), width); |
| 23385 | 23398 | ||
| 23386 | /* Then see if frame has specified a specific blink off cursor type. */ | 23399 | /* Then see if frame has specified a specific blink off cursor type. */ |
| @@ -25496,11 +25509,11 @@ note_mouse_highlight (struct frame *f, int x, int y) | |||
| 25496 | necessarily display the character whose position | 25509 | necessarily display the character whose position |
| 25497 | is the smallest. */ | 25510 | is the smallest. */ |
| 25498 | Lisp_Object lim1 = | 25511 | Lisp_Object lim1 = |
| 25499 | NILP (B_ (XBUFFER (buffer), bidi_display_reordering)) | 25512 | NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) |
| 25500 | ? Fmarker_position (w->start) | 25513 | ? Fmarker_position (w->start) |
| 25501 | : Qnil; | 25514 | : Qnil; |
| 25502 | Lisp_Object lim2 = | 25515 | Lisp_Object lim2 = |
| 25503 | NILP (B_ (XBUFFER (buffer), bidi_display_reordering)) | 25516 | NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) |
| 25504 | ? make_number (BUF_Z (XBUFFER (buffer)) | 25517 | ? make_number (BUF_Z (XBUFFER (buffer)) |
| 25505 | - XFASTINT (w->window_end_pos)) | 25518 | - XFASTINT (w->window_end_pos)) |
| 25506 | : Qnil; | 25519 | : Qnil; |
diff --git a/src/xfaces.c b/src/xfaces.c index 9ae35a74bd1..4cc47c85050 100644 --- a/src/xfaces.c +++ b/src/xfaces.c | |||
| @@ -5970,7 +5970,7 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop) | |||
| 5970 | { | 5970 | { |
| 5971 | int face_id; | 5971 | int face_id; |
| 5972 | 5972 | ||
| 5973 | if (NILP (B_ (current_buffer, enable_multibyte_characters))) | 5973 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 5974 | ch = 0; | 5974 | ch = 0; |
| 5975 | 5975 | ||
| 5976 | if (NILP (prop)) | 5976 | if (NILP (prop)) |
diff --git a/src/xfns.c b/src/xfns.c index 062bb105d0a..deb0e192a54 100644 --- a/src/xfns.c +++ b/src/xfns.c | |||
| @@ -3473,9 +3473,9 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 3473 | /* Initialize `default-minibuffer-frame' in case this is the first | 3473 | /* Initialize `default-minibuffer-frame' in case this is the first |
| 3474 | frame on this terminal. */ | 3474 | frame on this terminal. */ |
| 3475 | if (FRAME_HAS_MINIBUF_P (f) | 3475 | if (FRAME_HAS_MINIBUF_P (f) |
| 3476 | && (!FRAMEP (kb->Vdefault_minibuffer_frame) | 3476 | && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) |
| 3477 | || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) | 3477 | || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) |
| 3478 | kb->Vdefault_minibuffer_frame = frame; | 3478 | KVAR (kb, Vdefault_minibuffer_frame) = frame; |
| 3479 | 3479 | ||
| 3480 | /* All remaining specified parameters, which have not been "used" | 3480 | /* All remaining specified parameters, which have not been "used" |
| 3481 | by x_get_arg and friends, now go in the misc. alist of the frame. */ | 3481 | by x_get_arg and friends, now go in the misc. alist of the frame. */ |
| @@ -4610,7 +4610,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, | |||
| 4610 | Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); | 4610 | Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); |
| 4611 | old_buffer = current_buffer; | 4611 | old_buffer = current_buffer; |
| 4612 | set_buffer_internal_1 (XBUFFER (buffer)); | 4612 | set_buffer_internal_1 (XBUFFER (buffer)); |
| 4613 | B_ (current_buffer, truncate_lines) = Qnil; | 4613 | BVAR (current_buffer, truncate_lines) = Qnil; |
| 4614 | specbind (Qinhibit_read_only, Qt); | 4614 | specbind (Qinhibit_read_only, Qt); |
| 4615 | specbind (Qinhibit_modification_hooks, Qt); | 4615 | specbind (Qinhibit_modification_hooks, Qt); |
| 4616 | Ferase_buffer (); | 4616 | Ferase_buffer (); |
| @@ -5106,7 +5106,7 @@ Text larger than the specified size is clipped. */) | |||
| 5106 | /* Display the tooltip text in a temporary buffer. */ | 5106 | /* Display the tooltip text in a temporary buffer. */ |
| 5107 | old_buffer = current_buffer; | 5107 | old_buffer = current_buffer; |
| 5108 | set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); | 5108 | set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); |
| 5109 | B_ (current_buffer, truncate_lines) = Qnil; | 5109 | BVAR (current_buffer, truncate_lines) = Qnil; |
| 5110 | clear_glyph_matrix (w->desired_matrix); | 5110 | clear_glyph_matrix (w->desired_matrix); |
| 5111 | clear_glyph_matrix (w->current_matrix); | 5111 | clear_glyph_matrix (w->current_matrix); |
| 5112 | SET_TEXT_POS (pos, BEGV, BEGV_BYTE); | 5112 | SET_TEXT_POS (pos, BEGV, BEGV_BYTE); |
diff --git a/src/xterm.c b/src/xterm.c index 52d79e8dad7..909b6978f5a 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -7727,7 +7727,7 @@ x_connection_closed (Display *dpy, const char *error_message) | |||
| 7727 | { | 7727 | { |
| 7728 | /* Set this to t so that delete_frame won't get confused | 7728 | /* Set this to t so that delete_frame won't get confused |
| 7729 | trying to find a replacement. */ | 7729 | trying to find a replacement. */ |
| 7730 | FRAME_KBOARD (XFRAME (frame))->Vdefault_minibuffer_frame = Qt; | 7730 | KVAR (FRAME_KBOARD (XFRAME (frame)), Vdefault_minibuffer_frame) = Qt; |
| 7731 | delete_frame (frame, Qnoelisp); | 7731 | delete_frame (frame, Qnoelisp); |
| 7732 | } | 7732 | } |
| 7733 | 7733 | ||
| @@ -9966,7 +9966,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) | |||
| 9966 | { | 9966 | { |
| 9967 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); | 9967 | terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); |
| 9968 | init_kboard (terminal->kboard); | 9968 | init_kboard (terminal->kboard); |
| 9969 | terminal->kboard->Vwindow_system = Qx; | 9969 | KVAR (terminal->kboard, Vwindow_system) = Qx; |
| 9970 | 9970 | ||
| 9971 | /* Add the keyboard to the list before running Lisp code (via | 9971 | /* Add the keyboard to the list before running Lisp code (via |
| 9972 | Qvendor_specific_keysyms below), since these are not traced | 9972 | Qvendor_specific_keysyms below), since these are not traced |
| @@ -9988,7 +9988,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) | |||
| 9988 | /* Temporarily hide the partially initialized terminal. */ | 9988 | /* Temporarily hide the partially initialized terminal. */ |
| 9989 | terminal_list = terminal->next_terminal; | 9989 | terminal_list = terminal->next_terminal; |
| 9990 | UNBLOCK_INPUT; | 9990 | UNBLOCK_INPUT; |
| 9991 | terminal->kboard->Vsystem_key_alist | 9991 | KVAR (terminal->kboard, Vsystem_key_alist) |
| 9992 | = call1 (Qvendor_specific_keysyms, | 9992 | = call1 (Qvendor_specific_keysyms, |
| 9993 | vendor ? build_string (vendor) : empty_unibyte_string); | 9993 | vendor ? build_string (vendor) : empty_unibyte_string); |
| 9994 | BLOCK_INPUT; | 9994 | BLOCK_INPUT; |