Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 103314. ------------------------------------------------------------ revno: 103314 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 21:16:12 -0800 message: * lisp/progmodes/prolog.el: Header comment fix. diff: === modified file 'lisp/progmodes/prolog.el' --- lisp/progmodes/prolog.el 2011-01-28 19:46:58 +0000 +++ lisp/progmodes/prolog.el 2011-02-17 05:16:12 +0000 @@ -5,8 +5,9 @@ ;; Authors: Emil Åström ;; Milan Zamazal -;; Stefan Bruda (current maintainer) +;; Stefan Bruda ;; * See below for more details +;; Maintainer: Stefan Bruda ;; Keywords: prolog major mode sicstus swi mercury (defvar prolog-mode-version "1.22" ------------------------------------------------------------ revno: 103313 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 21:13:17 -0800 message: Convert some defvars to defcustoms. * lisp/speedbar.el (speedbar-ignored-modes, speedbar-file-unshown-regexp) (speedbar-update-flag, speedbar-fetch-etags-command) (speedbar-fetch-etags-arguments): * lisp/term.el (term-buffer-maximum-size, term-input-chunk-size) (term-completion-autolist, term-completion-addsuffix) (term-completion-recexact, term-completion-fignore): * lisp/term/sup-mouse.el (sup-mouse-fast-select-window): * lisp/term/x-win.el (x-select-request-type): Convert some defvars with "*" to defcustoms. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-17 05:02:02 +0000 +++ lisp/ChangeLog 2011-02-17 05:13:17 +0000 @@ -1,5 +1,15 @@ 2011-02-17 Glenn Morris + * speedbar.el (speedbar-ignored-modes, speedbar-file-unshown-regexp) + (speedbar-update-flag, speedbar-fetch-etags-command) + (speedbar-fetch-etags-arguments): + * term.el (term-buffer-maximum-size, term-input-chunk-size) + (term-completion-autolist, term-completion-addsuffix) + (term-completion-recexact, term-completion-fignore): + * term/sup-mouse.el (sup-mouse-fast-select-window): + * term/x-win.el (x-select-request-type): + Convert some defvars with "*" to defcustoms. + * shell.el (shell-delimiter-argument-list): Set it to nil. (Bug#8027) * vc/vc.el (vc-default-previous-version): === modified file 'lisp/speedbar.el' --- lisp/speedbar.el 2011-01-26 08:36:39 +0000 +++ lisp/speedbar.el 2011-02-17 05:13:17 +0000 @@ -614,8 +614,11 @@ :group 'speedbar :type 'hook) -(defvar speedbar-ignored-modes '(fundamental-mode) - "*List of major modes which speedbar will not switch directories for.") +(defcustom speedbar-ignored-modes '(fundamental-mode) + "List of major modes which speedbar will not switch directories for." + :group 'speedbar + :type '(choice (const nil) + (repeat :tag "List of modes" (symbol :tag "Major mode")))) (defun speedbar-extension-list-to-regex (extlist) "Takes EXTLIST, a list of extensions and transforms it into regexp. @@ -669,7 +672,7 @@ :group 'speedbar :type 'string) -(defvar speedbar-file-unshown-regexp +(defcustom speedbar-file-unshown-regexp (let ((nstr "") (noext completion-ignored-extensions)) (while noext (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" @@ -677,8 +680,10 @@ noext (cdr noext))) ;; backup refdir lockfile (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#")) - "*Regexp matching files we don't want displayed in a speedbar buffer. -It is generated from the variable `completion-ignored-extensions'.") + "Regexp matching files we don't want displayed in a speedbar buffer. +It is generated from the variable `completion-ignored-extensions'." + :group 'speedbar + :type 'string) (defvar speedbar-file-regexp nil "Regular expression matching files we know how to expand. @@ -755,14 +760,17 @@ speedbar-ignored-directory-regexp (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions))) -(defvar speedbar-update-flag dframe-have-timer-flag - "*Non-nil means to automatically update the display. +(defcustom speedbar-update-flag dframe-have-timer-flag + "Non-nil means to automatically update the display. When this is nil then speedbar will not follow the attached frame's directory. -When speedbar is active, use: - -\\ `\\[speedbar-toggle-updates]' - -to toggle this value.") +If you want to change this while speedbar is active, either use +\\[customize] or call \\ `\\[speedbar-toggle-updates]'." + :group 'speedbar + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set sym val) + (speedbar-toggle-updates)) + :type 'boolean) (defvar speedbar-update-flag-disable nil "Permanently disable changing of the update flag.") @@ -3643,17 +3651,20 @@ This variable is ignored if `speedbar-use-imenu-flag' is non-nil.") -(defvar speedbar-fetch-etags-command "etags" - "*Command used to create an etags file. - -This variable is ignored if `speedbar-use-imenu-flag' is t.") - -(defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") - "*List of arguments to use with `speedbar-fetch-etags-command'. +(defcustom speedbar-fetch-etags-command "etags" + "Command used to create an etags file. +This variable is ignored if `speedbar-use-imenu-flag' is t." + :group 'speedbar + :type 'string) + +(defcustom speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") + "List of arguments to use with `speedbar-fetch-etags-command'. This creates an etags output buffer. Use `speedbar-toggle-etags' to modify this list conveniently. - -This variable is ignored if `speedbar-use-imenu-flag' is t.") +This variable is ignored if `speedbar-use-imenu-flag' is t." + :group 'speedbar + :type '(choice (const nil) + (repeat :tag "List of arguments" string))) (defun speedbar-toggle-etags (flag) "Toggle FLAG in `speedbar-fetch-etags-arguments'. === modified file 'lisp/term.el' --- lisp/term.el 2011-01-25 04:08:28 +0000 +++ lisp/term.el 2011-02-17 05:13:17 +0000 @@ -762,11 +762,13 @@ "magenta3" "cyan3" "white"]) ;; Inspiration came from comint.el -mm -(defvar term-buffer-maximum-size 2048 - "*The maximum size in lines for term buffers. +(defcustom term-buffer-maximum-size 2048 + "The maximum size in lines for term buffers. Term buffers are truncated from the top to be no greater than this number. Notice that a setting of 0 means \"don't truncate anything\". This variable -is buffer-local.") +is buffer-local." + :group 'term + :type 'integer) (when (featurep 'xemacs) (defvar term-terminal-menu @@ -2209,9 +2211,11 @@ ;;; Low-level process communication -(defvar term-input-chunk-size 512 - "*Long inputs send to term processes are broken up into chunks of this size. -If your process is choking on big inputs, try lowering the value.") +(defcustom term-input-chunk-size 512 + "Long inputs send to term processes are broken up into chunks of this size. +If your process is choking on big inputs, try lowering the value." + :group 'term + :type 'integer) (defun term-send-string (proc str) "Send to PROC the contents of STR as input. @@ -3909,27 +3913,38 @@ ;; Commands like this are fine things to put in load hooks if you ;; want them present in specific modes. -(defvar term-completion-autolist nil - "*If non-nil, automatically list possibilities on partial completion. -This mirrors the optional behavior of tcsh.") +(defcustom term-completion-autolist nil + "If non-nil, automatically list possibilities on partial completion. +This mirrors the optional behavior of tcsh." + :group 'term + :type 'boolean) -(defvar term-completion-addsuffix t - "*If non-nil, add a `/' to completed directories, ` ' to file names. +(defcustom term-completion-addsuffix t + "If non-nil, add a `/' to completed directories, ` ' to file names. If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact -completion. This mirrors the optional behavior of tcsh.") +completion. This mirrors the optional behavior of tcsh." + :group 'term + :type '(choice (const :tag "No suffix" nil) + (cons (string :tag "dirsuffix") (string :tag "filesuffix")) + (other :tag "Suffix" t))) -(defvar term-completion-recexact nil - "*If non-nil, use shortest completion if characters cannot be added. +(defcustom term-completion-recexact nil + "If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. -A non-nil value is useful if `term-completion-autolist' is non-nil too.") +A non-nil value is useful if `term-completion-autolist' is non-nil too." + :group 'term + :type 'boolean) -(defvar term-completion-fignore nil - "*List of suffixes to be disregarded during file completion. +(defcustom term-completion-fignore nil + "List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. -Note that this applies to `term-dynamic-complete-filename' only.") +Note that this applies to `term-dynamic-complete-filename' only." + :group 'term + :type '(choice (const nil) + (repeat :tag "List of suffixes" string))) (defvar term-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. === modified file 'lisp/term/sup-mouse.el' --- lisp/term/sup-mouse.el 2011-01-25 04:08:28 +0000 +++ lisp/term/sup-mouse.el 2011-02-17 05:13:17 +0000 @@ -30,8 +30,11 @@ ;;; User customization option: -(defvar sup-mouse-fast-select-window nil - "*Non-nil for mouse hits to select new window, then execute; else just select.") +(defcustom sup-mouse-fast-select-window nil + "Non-nil means mouse hits select new window, then execute. +Otherwise just select." + :type 'boolean + :group 'mouse) (defconst mouse-left 0) (defconst mouse-center 1) === modified file 'lisp/term/x-win.el' --- lisp/term/x-win.el 2011-02-01 21:37:12 +0000 +++ lisp/term/x-win.el 2011-02-17 05:13:17 +0000 @@ -1167,20 +1167,28 @@ :group 'killing :version "24.1") -(defvar x-select-request-type nil - "*Data type request for X selection. +(defcustom x-select-request-type nil + "Data type request for X selection. The value is one of the following data types, a list of them, or nil: `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' -If the value is one of the above symbols, try only the specified -type. +If the value is one of the above symbols, try only the specified type. If the value is a list of them, try each of them in the specified order until succeed. -The value nil is the same as this list: - \(UTF8_STRING COMPOUND_TEXT STRING) -") +The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." + :type '(choice (const :tag "Default" nil) + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT) + (set :tag "List of values" + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT))) + :group 'killing) ;; Get a selection value of type TYPE by calling x-get-selection with ;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. ------------------------------------------------------------ revno: 103312 committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2011-02-17 05:09:02 +0000 message: auth-source.el (auth-source-secrets-search): Use mm-delete-duplicates instead of delete-dups that is not available in XEmacs 21.4. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-02-16 23:12:47 +0000 +++ lisp/gnus/ChangeLog 2011-02-17 05:09:02 +0000 @@ -1,3 +1,8 @@ +2011-02-17 Katsumi Yamaoka + + * auth-source.el (auth-source-secrets-search): Use mm-delete-duplicates + instead of delete-dups that is not available in XEmacs 21.4. + 2011-02-16 Lars Ingebrigtsen * gnus-sum.el (gnus-propagate-marks): Change default to t again, since === modified file 'lisp/gnus/auth-source.el' --- lisp/gnus/auth-source.el 2011-02-16 23:12:47 +0000 +++ lisp/gnus/auth-source.el 2011-02-17 05:09:02 +0000 @@ -40,6 +40,7 @@ ;;; Code: (require 'password-cache) +(require 'mm-util) (require 'gnus-util) (require 'netrc) (require 'assoc) @@ -1042,9 +1043,9 @@ (list k (plist-get spec k)))) search-keys))) ;; needed keys (always including host, login, protocol, and secret) - (returned-keys (delete-dups (append - '(:host :login :protocol :secret) - search-keys))) + (returned-keys (mm-delete-duplicates (append + '(:host :login :protocol :secret) + search-keys))) (items (loop for item in (apply 'secrets-search-items coll search-spec) unless (and (stringp label) (not (string-match label item))) ------------------------------------------------------------ revno: 103311 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 21:02:02 -0800 message: shell.el fix for bug#8027 and friends. * lisp/shell.el (shell-delimiter-argument-list): Set it to nil. This is a test, to see if causes any issues. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-17 04:57:22 +0000 +++ lisp/ChangeLog 2011-02-17 05:02:02 +0000 @@ -1,5 +1,7 @@ 2011-02-17 Glenn Morris + * shell.el (shell-delimiter-argument-list): Set it to nil. (Bug#8027) + * vc/vc.el (vc-default-previous-version): Remove alias that points nowhere. (Bug#4496) === modified file 'lisp/shell.el' --- lisp/shell.el 2011-01-26 08:36:39 +0000 +++ lisp/shell.el 2011-02-17 05:02:02 +0000 @@ -151,12 +151,14 @@ :type '(repeat (string :tag "Suffix")) :group 'shell) -(defvar shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;) +(defcustom shell-delimiter-argument-list nil ; '(?\| ?& ?< ?> ?\( ?\) ?\;) "List of characters to recognize as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the -shell buffer. The value may depend on the operating system or shell. - -This is a fine thing to set in your `.emacs' file.") +shell buffer. The value may depend on the operating system or shell." + :type '(choice (const nil) + (repeat :tag "List of characters" character)) + :version "24.1" ; changed to nil (bug#8027) + :group 'shell) (defvar shell-file-name-chars (if (memq system-type '(ms-dos windows-nt cygwin)) ------------------------------------------------------------ revno: 103310 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 20:57:22 -0800 message: vc.el fix for bug#4496. * lisp/vc/vc.el (vc-default-previous-version): Remove broken alias that points nowhere. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-17 04:50:47 +0000 +++ lisp/ChangeLog 2011-02-17 04:57:22 +0000 @@ -1,5 +1,8 @@ 2011-02-17 Glenn Morris + * vc/vc.el (vc-default-previous-version): + Remove alias that points nowhere. (Bug#4496) + * dired-x.el (dired-clean-up-after-deletion): kill-buffer does not need save-excursion. (dired-do-run-mail): Doc fix. === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2011-02-13 03:07:53 +0000 +++ lisp/vc/vc.el 2011-02-17 04:57:22 +0000 @@ -2614,9 +2614,6 @@ (when index (substring rev 0 index)))) -(define-obsolete-function-alias - 'vc-default-previous-version 'vc-default-previous-revision "23.1") - (defun vc-default-responsible-p (backend file) "Indicate whether BACKEND is reponsible for FILE. The default is to return nil always." ------------------------------------------------------------ revno: 103309 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 20:50:47 -0800 message: More dired-x cleanup. * lisp/dired-x.el (dired-clean-up-after-deletion): kill-buffer does not need save-excursion. (dired-do-run-mail): Doc fix. (dired-filename-at-point): Doc fix. Use looking-at, and skip-chars rather than re search. (skip-chars were used prior to CVS rev 1.47, and are ok to use again since Emacs 22.1, because char-classes are supported.) diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-17 04:38:23 +0000 +++ lisp/ChangeLog 2011-02-17 04:50:47 +0000 @@ -1,5 +1,11 @@ 2011-02-17 Glenn Morris + * dired-x.el (dired-clean-up-after-deletion): + kill-buffer does not need save-excursion. + (dired-do-run-mail): Doc fix. + (dired-filename-at-point): Doc fix. + Use looking-at, and skip-chars rather than re search. + * dired-x.el (dired-filename-at-point): Fix 8-year old typo. 2011-02-16 Ken Manheimer === modified file 'lisp/dired-x.el' --- lisp/dired-x.el 2011-02-17 04:38:23 +0000 +++ lisp/dired-x.el 2011-02-17 04:50:47 +0000 @@ -319,7 +319,6 @@ `dired-info' `dired-do-find-marked-files'" (interactive) - ;; These must be done in each new dired buffer. (dired-hack-local-variables) (dired-omit-startup)) @@ -341,17 +340,14 @@ (funcall (function y-or-n-p) (format "Kill buffer of %s, too? " (file-name-nondirectory fn))) - (save-excursion ; you never know where kill-buffer leaves you - (kill-buffer buf)))) + (kill-buffer buf))) (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) (and buf-list (y-or-n-p (format "Kill dired buffer%s of %s, too? " (dired-plural-s (length buf-list)) (file-name-nondirectory fn))) (dolist (buf buf-list) - (save-excursion (kill-buffer buf)))))) - ;; Anything else? - ) + (kill-buffer buf)))))) ;;; EXTENSION MARKING FUNCTIONS. @@ -1404,7 +1400,7 @@ (rmail (dired-get-filename))) (defun dired-do-run-mail () - "If `dired-bind-vm' is t, then function `dired-vm', otherwise `dired-rmail'." + "If `dired-bind-vm' is non-nil, call `dired-vm', else call `dired-rmail'." (interactive) (if dired-bind-vm ;; Read mail folder using vm. @@ -1655,38 +1651,32 @@ ;; Fixme: This should probably use `thing-at-point'. -- fx (defun dired-filename-at-point () - "Get the filename closest to point, but do not change position. -Has a preference for looking backward when not directly on a symbol. -Not perfect - point must be in middle of or end of filename." - + "Return the filename closest to point, expanded. +Point should be in or after a filename." (let ((filename-chars "-.[:alnum:]_/:$+@") start end filename prefix) - (save-excursion ;; First see if just past a filename. - (or (eobp) + (or (eobp) ; why? (when (looking-at "[] \t\n[{}()]") ; whitespace or some parens (skip-chars-backward " \n\t\r({[]})") (or (bobp) (backward-char 1)))) - (if (string-match (concat "[" filename-chars "]") - (char-to-string (following-char))) + (if (looking-at (format "[%s]" filename-chars)) (progn - (if (re-search-backward (concat "[^" filename-chars "]") nil t) - (forward-char) - (goto-char (point-min))) - (setq start (point)) - (setq prefix + (skip-chars-backward filename-chars) + (setq start (point) + prefix + ;; This is something to do with ange-ftp filenames. + ;; It convert foo@bar to /foo@bar. + ;; But when does the former occur in dired buffers? (and (string-match "^\\w+@" (buffer-substring start (line-end-position))) "/")) - (goto-char start) (if (string-match "[/~]" (char-to-string (preceding-char))) (setq start (1- start))) - (re-search-forward (concat "\\=[" filename-chars "]*") nil t)) - + (skip-chars-forward filename-chars)) (error "No file found around point!")) - ;; Return string. (expand-file-name (concat prefix (buffer-substring start (point))))))) ------------------------------------------------------------ revno: 103308 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 20:41:29 -0800 message: Fix copyright, standardize header and licence. diff: === modified file 'lisp/net/soap-client.el' --- lisp/net/soap-client.el 2011-02-16 19:56:31 +0000 +++ lisp/net/soap-client.el 2011-02-17 04:41:29 +0000 @@ -1,25 +1,26 @@ ;;;; soap-client.el -- Access SOAP web services from Emacs -;; Copyright (C) 2009-2011 Alex Harsanyi - -;; This program is free software: you can redistribute it and/or modify +;; Copyright (C) 2009-2011 Free Software Foundation, Inc. + +;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) +;; Created: December, 2009 +;; Keywords: soap, web-services, comm, hypermedia +;; Homepage: http://code.google.com/p/emacs-soap-client + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) -;; Created: December, 2009 -;; Keywords: soap, web-services, comm, hypermedia -;; Homepage: http://code.google.com/p/emacs-soap-client -;; +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -1733,7 +1734,6 @@ ;;; Local Variables: -;;; mode: emacs-lisp ;;; mode: outline-minor ;;; outline-regexp: ";;;;+" ;;; End: === modified file 'lisp/net/soap-inspect.el' --- lisp/net/soap-inspect.el 2011-02-16 19:33:35 +0000 +++ lisp/net/soap-inspect.el 2011-02-17 04:41:29 +0000 @@ -1,25 +1,26 @@ ;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures -;; Copyright (C) 2010-2011 Alex Harsanyi - -;; This program is free software: you can redistribute it and/or modify +;; Copyright (C) 2010-2011 Free Software Foundation, Inc. + +;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) +;; Created: October 2010 +;; Keywords: soap, web-services, comm, hypermedia +;; Homepage: http://code.google.com/p/emacs-soap-client + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) -;; Created: October 2010 -;; Keywords: soap, web-services, comm, hypermedia -;; Homepage: http://code.google.com/p/emacs-soap-client -;; +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ------------------------------------------------------------ revno: 103307 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 20:38:23 -0800 message: * lisp/dired-x.el (dired-filename-at-point): Fix 8-year old typo. Introduced in CVS rev 1.47, 2003/01/27. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 22:10:43 +0000 +++ lisp/ChangeLog 2011-02-17 04:38:23 +0000 @@ -1,3 +1,7 @@ +2011-02-17 Glenn Morris + + * dired-x.el (dired-filename-at-point): Fix 8-year old typo. + 2011-02-16 Ken Manheimer * allout-widgets.el: New allout extension that shows allout === modified file 'lisp/dired-x.el' --- lisp/dired-x.el 2011-02-16 08:51:39 +0000 +++ lisp/dired-x.el 2011-02-17 04:38:23 +0000 @@ -1678,7 +1678,7 @@ (setq prefix (and (string-match "^\\w+@" - (buffer-substring start (line-beginning-position))) + (buffer-substring start (line-end-position))) "/")) (goto-char start) (if (string-match "[/~]" (char-to-string (preceding-char))) ------------------------------------------------------------ revno: 103306 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Wed 2011-02-16 23:12:47 +0000 message: Merge changes made in Gnus trunk. gnus-sum.el (gnus-propagate-marks): Change default to t again, since nil means that nnimap doesn't get updated. auth-source.el (auth-source-netrc-create): Return a synthetic search result when the user doesn't want to write to the file. (auth-source-netrc-search): Expect a synthetic result and proceed accordingly. (auth-source-cache-expiry): New variable to override `password-cache-expiry'. (auth-source-remember): Use it. nnimap.el (nnimap-credentials): Remove the `inhibit-create' parameter. Create entry if necessary by using :create t. (nnimap-open-connection-1): Don't pass `inhibit-create'. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-02-16 00:00:21 +0000 +++ lisp/gnus/ChangeLog 2011-02-16 23:12:47 +0000 @@ -1,3 +1,22 @@ +2011-02-16 Lars Ingebrigtsen + + * gnus-sum.el (gnus-propagate-marks): Change default to t again, since + nil means that nnimap doesn't get updated. + +2011-02-16 Teodor Zlatanov + + * auth-source.el (auth-source-netrc-create): Return a synthetic search + result when the user doesn't want to write to the file. + (auth-source-netrc-search): Expect a synthetic result and proceed + accordingly. + (auth-source-cache-expiry): New variable to override + `password-cache-expiry'. + (auth-source-remember): Use it. + + * nnimap.el (nnimap-credentials): Remove the `inhibit-create' + parameter. Create entry if necessary by using :create t. + (nnimap-open-connection-1): Don't pass `inhibit-create'. + 2011-02-15 Teodor Zlatanov * auth-source.el (auth-source-debug): Enable by default and don't === modified file 'lisp/gnus/auth-source.el' --- lisp/gnus/auth-source.el 2011-02-16 00:00:21 +0000 +++ lisp/gnus/auth-source.el 2011-02-16 23:12:47 +0000 @@ -61,6 +61,18 @@ :version "23.1" ;; No Gnus :group 'gnus) +;;;###autoload +(defcustom auth-source-cache-expiry 7200 + "How many seconds passwords are cached, or nil to disable +expiring. Overrides `password-cache-expiry' through a +let-binding." + :group 'auth-source + :type '(choice (const :tag "Never" nil) + (const :tag "All Day" 86400) + (const :tag "2 Hours" 7200) + (const :tag "30 Minutes" 1800) + (integer :tag "Seconds"))) + (defclass auth-source-backend () ((type :initarg :type :initform 'netrc @@ -588,8 +600,9 @@ (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." - (password-cache-add - (concat auth-source-magic (format "%S" spec)) found)) + (let ((password-cache-expiry auth-source-cache-expiry)) + (password-cache-add + (concat auth-source-magic (format "%S" spec)) found))) (defun auth-source-recall (spec) "Recall FOUND search results for SPEC." @@ -808,14 +821,17 @@ (when (and create (= 0 (length results))) - ;; create based on the spec - (apply (slot-value backend 'create-function) spec) - ;; turn off the :create key - (setq spec (plist-put spec :create nil)) - ;; run the search again to get the updated data - ;; the result will be returned, even if the search fails - (setq results (apply 'auth-source-netrc-search spec))) + ;; create based on the spec and record the value + (setq results (or + ;; if the user did not want to create the entry + ;; in the file, it will be returned + (apply (slot-value backend 'create-function) spec) + ;; if not, we do the search again without :create + ;; to get the updated data. + ;; the result will be returned, even if the search fails + (apply 'auth-source-netrc-search + (plist-put spec :create nil))))) results)) ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) @@ -833,7 +849,9 @@ (file (oref backend source)) (add "") ;; `valist' is an alist - valist) + valist + ;; `artificial' will be returned if no creation is needed + artificial) ;; only for base required elements (defined as function parameters): ;; fill in the valist with whatever data we may have from the search @@ -902,6 +920,14 @@ nil nil default)) (t data)))) + (when data + (setq artificial (plist-put artificial + (intern (concat ":" (symbol-name r))) + (if (eq r 'secret) + (lexical-let ((data data)) + (lambda () data)) + data)))) + ;; when r is not an empty string... (when (and (stringp data) (< 0 (length data))) @@ -935,14 +961,17 @@ (goto-char (point-max)) ;; ask AFTER we've successfully opened the file - (when (y-or-n-p (format "Add to file %s: line [%s]" file add)) - (unless (bolp) - (insert "\n")) - (insert add "\n") - (write-region (point-min) (point-max) file nil 'silent) - (auth-source-do-debug - "auth-source-netrc-create: wrote 1 new line to %s" - file))))) + (if (y-or-n-p (format "Add to file %s: line [%s]" file add)) + (progn + (unless (bolp) + (insert "\n")) + (insert add "\n") + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-create: wrote 1 new line to %s" + file) + nil) + (list artificial))))) ;;; Backend specific parsing: Secrets API backend === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2011-02-15 11:24:37 +0000 +++ lisp/gnus/gnus-sum.el 2011-02-16 23:12:47 +0000 @@ -1234,11 +1234,10 @@ :type 'boolean :group 'gnus-summary-marks) -(defcustom gnus-propagate-marks nil +(defcustom gnus-propagate-marks t "If non-nil, Gnus will store and retrieve marks from the backends. This means that marks will be stored both in .newsrc.eld and in the backend, and will slow operation down somewhat." - :version "24.1" :type 'boolean :group 'gnus-summary-marks) === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-02-14 04:23:59 +0000 +++ lisp/gnus/nnimap.el 2011-02-16 23:12:47 +0000 @@ -276,13 +276,11 @@ (push (current-buffer) nnimap-process-buffers) (current-buffer))) -(defun nnimap-credentials (address ports &optional inhibit-create) +(defun nnimap-credentials (address ports) (let* ((found (nth 0 (auth-source-search :max 1 :host address :port ports - :create (if inhibit-create - nil - (null ports))))) + :create t))) (user (plist-get found :user)) (secret (plist-get found :secret)) (secret (if (functionp secret) (funcall secret) secret))) @@ -389,7 +387,7 @@ (list (nnoo-current-server 'nnimap) nnimap-address) - ports t)))) + ports)))) (setq nnimap-object nil) (let ((nnimap-inhibit-logging t)) (setq login-result ------------------------------------------------------------ revno: 103305 committer: Ken Manheimer branch nick: trunk timestamp: Wed 2011-02-16 17:10:43 -0500 message: * lisp/allout-widgets.el: New allout extension that shows allout outline structure with graphical widgets. 'allout-widgets' customize group is an 'allout' subgroup, for easy discovery. * etc/images/icons/allout-widgets-dark-bg, etc/images/icons/allout-widgets-light-bg: Icons for new allout-widgets.el. * etc/images/icons/README: Include coypright and GPL 3 license for new icons. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-02-16 19:41:31 +0000 +++ etc/ChangeLog 2011-02-16 22:10:43 +0000 @@ -1,3 +1,12 @@ +2011-02-16 Ken Manheimer + + * etc/images/icons/allout-widgets-dark-bg, + etc/images/icons/allout-widgets-light-bg: Icons for new + allout-widgets.el. + + * etc/images/icons/README: Include coypright and GPL 3 license for + new icons. + 2011-02-16 Michael Albinus * NEWS: Add soap-client.el and soap-inspect.el. === modified file 'etc/images/icons/README' --- etc/images/icons/README 2011-01-25 04:08:28 +0000 +++ etc/images/icons/README 2011-02-16 22:10:43 +0000 @@ -15,3 +15,52 @@ Author: Andrew Zhilin Copyright (C) 2005-2011 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) + +Files: allout-widgets-dark-bg/closed.png + allout-widgets-dark-bg/closed.xpm + allout-widgets-dark-bg/empty.png + allout-widgets-dark-bg/empty.xpm + allout-widgets-dark-bg/encrypted-locked.png + allout-widgets-dark-bg/encrypted-locked.xpm + allout-widgets-dark-bg/encrypted-unlocked.png + allout-widgets-dark-bg/encrypted-unlocked.xpm + allout-widgets-dark-bg/end-connector.png + allout-widgets-dark-bg/end-connector.xpm + allout-widgets-dark-bg/extender-connector.png + allout-widgets-dark-bg/extender-connector.xpm + allout-widgets-dark-bg/leaf.png + allout-widgets-dark-bg/leaf.xpm + allout-widgets-dark-bg/mid-connector.png + allout-widgets-dark-bg/mid-connector.xpm + allout-widgets-dark-bg/opened.png + allout-widgets-dark-bg/opened.xpm + allout-widgets-dark-bg/skip-descender.png + allout-widgets-dark-bg/skip-descender.xpm + allout-widgets-dark-bg/through-descender.png + allout-widgets-dark-bg/through-descender.xpm + allout-widgets-light-bg/closed.png + allout-widgets-light-bg/closed.xpm + allout-widgets-light-bg/empty.png + allout-widgets-light-bg/empty.xpm + allout-widgets-light-bg/encrypted-locked.png + allout-widgets-light-bg/encrypted-locked.xpm + allout-widgets-light-bg/encrypted-unlocked.png + allout-widgets-light-bg/encrypted-unlocked.xpm + allout-widgets-light-bg/end-connector.png + allout-widgets-light-bg/end-connector.xpm + allout-widgets-light-bg/extender-connector.png + allout-widgets-light-bg/extender-connector.xpm + allout-widgets-light-bg/leaf.png + allout-widgets-light-bg/leaf.xpm + allout-widgets-light-bg/mid-connector.png + allout-widgets-light-bg/mid-connector.xpm + allout-widgets-light-bg/opened.png + allout-widgets-light-bg/opened.xpm + allout-widgets-light-bg/skip-descender.png + allout-widgets-light-bg/skip-descender.xpm + allout-widgets-light-bg/through-descender.png + allout-widgets-light-bg/through-descender.xpm + +Author: Ken Manheimer +Copyright (C) 2011 Free Software Foundation, Inc. +License: GNU General Public License version 3 or later (see COPYING) === added directory 'etc/images/icons/allout-widgets-dark-bg' === added file 'etc/images/icons/allout-widgets-dark-bg/closed.png' Binary files etc/images/icons/allout-widgets-dark-bg/closed.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/closed.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/closed.xpm' --- etc/images/icons/allout-widgets-dark-bg/closed.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/closed.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,30 @@ +/* XPM */ +static char *dummy[]={ +"9 17 10 1", +". c None", +"# c #000080", +"h c #52a55a", +"g c #52ad52", +"e c #5ab54a", +"d c #5abd42", +"c c #63c639", +"b c #63ce31", +"f c #ada5c6", +"a c #ffff00", +".........", +".........", +".........", +"######...", +"aaaaaa#..", +".bbcdaa#.", +".###deaa#", +"..ff##gaa", +"fffff##ha", +"..ff##haa", +".###ghaa#", +".eeggaa#.", +"aaaaaa#..", +"######...", +".........", +".........", +"........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/empty.png' Binary files etc/images/icons/allout-widgets-dark-bg/empty.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/empty.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/empty.xpm' --- etc/images/icons/allout-widgets-dark-bg/empty.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/empty.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,29 @@ +/* XPM */ +static char *dummy[]={ +"10 17 9 1", +". c None", +"# c #000080", +"f c #52a55a", +"g c #52ad52", +"d c #5abd42", +"b c #63c639", +"c c #6bd629", +"e c #ada5c6", +"a c #ffff00", +"..........", +"..........", +"..........", +"...######.", +"..#aaaaaa.", +".#aabbbb..", +"#aabc###..", +"aad##ee...", +"adeeeee...", +"aad##ee...", +"#aafg###..", +".#aabbbb..", +"..#aaaaaa.", +"...######.", +"..........", +"..........", +".........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png' Binary files etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm' --- etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"b c #333300", +"# c #666600", +"d c #808080", +"c c #999933", +"a c #999966", +"..........", +"..........", +"..........", +"..........", +"...##a#...", +"..aaaaaa..", +".aa....##.", +".ab....a#.", +".cb....#b.", +"caaaaaaacb", +"cddddddddb", +"adaddddddb", +"adaddddddb", +"caadddddab", +"addddddddb", +"bbbbbbbbbb", +".........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png' Binary files etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm' --- etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"c c #333300", +"a c #666600", +"b c #999933", +"# c #999966", +"d c #ffff00", +"..........", +"..........", +"..........", +"...####...", +"..#a#a###.", +"..a#...##.", +".a#.....#.", +".##.......", +"..##......", +"b###c###bc", +"bddddddddc", +"#d#ddddddc", +"#d#ddddddc", +"b##ddddd#c", +"#ddddddddc", +"cccccccccc", +".........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/end-connector.png' Binary files etc/images/icons/allout-widgets-dark-bg/end-connector.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/end-connector.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/end-connector.xpm' --- etc/images/icons/allout-widgets-dark-bg/end-connector.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/end-connector.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +".....######", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/extender-connector.png' Binary files etc/images/icons/allout-widgets-dark-bg/extender-connector.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/extender-connector.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm' --- etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"###########", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/leaf.png' Binary files etc/images/icons/allout-widgets-dark-bg/leaf.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/leaf.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/leaf.xpm' --- etc/images/icons/allout-widgets-dark-bg/leaf.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/leaf.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,33 @@ +/* XPM */ +static char *dummy[]={ +"16 21 9 1", +". c None", +"a c #737373", +"b c #7b7b7b", +"# c #808080", +"c c #848484", +"d c #8c8c8c", +"e c #949494", +"f c #9c9c9c", +"g c #a5a5a5", +"................", +"................", +"................", +"................", +"................", +"................", +"...#####........", +"..#abbcc#.......", +".#abbccdd#......", +"#abbccddee#.....", +"#bbccddeef#.....", +"#bccddeefg#.....", +".#cddeefg#......", +"..#deefg#.......", +"...#####........", +"................", +"................", +"................", +"................", +"................", +"................"}; === added file 'etc/images/icons/allout-widgets-dark-bg/mid-connector.png' Binary files etc/images/icons/allout-widgets-dark-bg/mid-connector.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/mid-connector.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm' --- etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +"....#.#####", +"....##.....", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; === added file 'etc/images/icons/allout-widgets-dark-bg/opened.png' Binary files etc/images/icons/allout-widgets-dark-bg/opened.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/opened.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/opened.xpm' --- etc/images/icons/allout-widgets-dark-bg/opened.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/opened.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,25 @@ +/* XPM */ +static char *dummy[]={ +"10 17 5 1", +". c None", +"a c #000080", +"b c #63c639", +"c c #ada5c6", +"# c #ffff00", +"..........", +"..........", +"..........", +"..........", +"#.......#a", +"#ba...ab#a", +"#ba...ab#a", +"#bccccab#a", +"#bacccab#a", +"#bbacabb#a", +"##bacab##a", +"a##bbb##a.", +".a#####a..", +"..a###a...", +"...a#a....", +"....c.....", +"....c....."}; === added file 'etc/images/icons/allout-widgets-dark-bg/skip-descender.png' Binary files etc/images/icons/allout-widgets-dark-bg/skip-descender.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/skip-descender.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm' --- etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,21 @@ +/* XPM */ +static char *dummy[]={ +"11 17 1 1", +". c None", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; === added file 'etc/images/icons/allout-widgets-dark-bg/through-descender.png' Binary files etc/images/icons/allout-widgets-dark-bg/through-descender.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-dark-bg/through-descender.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-dark-bg/through-descender.xpm' --- etc/images/icons/allout-widgets-dark-bg/through-descender.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-dark-bg/through-descender.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; === added directory 'etc/images/icons/allout-widgets-light-bg' === added file 'etc/images/icons/allout-widgets-light-bg/closed.png' Binary files etc/images/icons/allout-widgets-light-bg/closed.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/closed.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/closed.xpm' --- etc/images/icons/allout-widgets-light-bg/closed.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/closed.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,24 @@ +/* XPM */ +static char *dummy[]={ +"9 17 4 1", +". c None", +"# c #00ff00", +"b c #00ffff", +"a c #606060", +".........", +".........", +".........", +"######...", +"aaaaaa#..", +".bbbbaa#.", +"....bbaa#", +"..aa..baa", +"aaaaa..ba", +"..aa..baa", +"....bbaa#", +".bbbbaa#.", +"aaaaaa#..", +"######...", +".........", +".........", +"........."}; === added file 'etc/images/icons/allout-widgets-light-bg/empty.png' Binary files etc/images/icons/allout-widgets-light-bg/empty.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/empty.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/empty.xpm' --- etc/images/icons/allout-widgets-light-bg/empty.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/empty.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,24 @@ +/* XPM */ +static char *dummy[]={ +"10 17 4 1", +". c None", +"# c #00ff00", +"b c #00ffff", +"a c #606060", +"..........", +"..........", +"..........", +"...######.", +"..#aaaaaa.", +".#aabbbb..", +"#aabb.....", +"aab..aa...", +"abaaaaa...", +"aab..aa...", +"#aabb.....", +".#aabbbb..", +"..#aaaaaa.", +"...######.", +"..........", +"..........", +".........."}; === added file 'etc/images/icons/allout-widgets-light-bg/encrypted-locked.png' Binary files etc/images/icons/allout-widgets-light-bg/encrypted-locked.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/encrypted-locked.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm' --- etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"b c #333300", +"# c #666600", +"d c #808080", +"c c #999933", +"a c #999966", +"..........", +"..........", +"..........", +"..........", +"...##a#...", +"..aaaaaa..", +".aa....##.", +".ab....a#.", +".cb....#b.", +"caaaaaaacb", +"cddddddddb", +"adaddddddb", +"adaddddddb", +"caadddddab", +"addddddddb", +"bbbbbbbbbb", +".........."}; === added file 'etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png' Binary files etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm' --- etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"c c #333300", +"a c #666600", +"b c #999933", +"# c #999966", +"d c #ffff00", +"..........", +"..........", +"..........", +"...####...", +"..#a#a###.", +"..a#...##.", +".a#.....#.", +".##.......", +"..##......", +"b###c###bc", +"bddddddddc", +"#d#ddddddc", +"#d#ddddddc", +"b##ddddd#c", +"#ddddddddc", +"cccccccccc", +".........."}; === added file 'etc/images/icons/allout-widgets-light-bg/end-connector.png' Binary files etc/images/icons/allout-widgets-light-bg/end-connector.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/end-connector.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/end-connector.xpm' --- etc/images/icons/allout-widgets-light-bg/end-connector.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/end-connector.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +".....######", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; === added file 'etc/images/icons/allout-widgets-light-bg/extender-connector.png' Binary files etc/images/icons/allout-widgets-light-bg/extender-connector.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/extender-connector.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/extender-connector.xpm' --- etc/images/icons/allout-widgets-light-bg/extender-connector.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/extender-connector.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"###########", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; === added file 'etc/images/icons/allout-widgets-light-bg/leaf.png' Binary files etc/images/icons/allout-widgets-light-bg/leaf.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/leaf.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/leaf.xpm' --- etc/images/icons/allout-widgets-light-bg/leaf.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/leaf.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,33 @@ +/* XPM */ +static char *dummy[]={ +"16 21 9 1", +". c None", +"a c #737373", +"b c #7b7b7b", +"# c #808080", +"c c #848484", +"d c #8c8c8c", +"e c #949494", +"f c #9c9c9c", +"g c #a5a5a5", +"................", +"................", +"................", +"................", +"................", +"................", +"...#####........", +"..#abbcc#.......", +".#abbccdd#......", +"#abbccddee#.....", +"#bbccddeef#.....", +"#bccddeefg#.....", +".#cddeefg#......", +"..#deefg#.......", +"...#####........", +"................", +"................", +"................", +"................", +"................", +"................"}; === added file 'etc/images/icons/allout-widgets-light-bg/mid-connector.png' Binary files etc/images/icons/allout-widgets-light-bg/mid-connector.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/mid-connector.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/mid-connector.xpm' --- etc/images/icons/allout-widgets-light-bg/mid-connector.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/mid-connector.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +"....#.#####", +"....##.....", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; === added file 'etc/images/icons/allout-widgets-light-bg/opened.png' Binary files etc/images/icons/allout-widgets-light-bg/opened.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/opened.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/opened.xpm' --- etc/images/icons/allout-widgets-light-bg/opened.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/opened.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,24 @@ +/* XPM */ +static char *dummy[]={ +"10 17 4 1", +". c None", +"a c #00ff00", +"b c #00ffff", +"# c #606060", +"..........", +"..........", +"..........", +"..........", +"#.......#a", +"#b.....b#a", +"#b.....b#a", +"#b####.b#a", +"#b.###.b#a", +"#bb.#.bb#a", +"##b.#.b##a", +"a##b#b##a.", +".a##b##a..", +"..a###a...", +"...a#a....", +"....#.....", +"....#....."}; === added file 'etc/images/icons/allout-widgets-light-bg/skip-descender.png' Binary files etc/images/icons/allout-widgets-light-bg/skip-descender.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/skip-descender.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/skip-descender.xpm' --- etc/images/icons/allout-widgets-light-bg/skip-descender.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/skip-descender.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,21 @@ +/* XPM */ +static char *dummy[]={ +"11 17 1 1", +". c None", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; === added file 'etc/images/icons/allout-widgets-light-bg/through-descender.png' Binary files etc/images/icons/allout-widgets-light-bg/through-descender.png 1970-01-01 00:00:00 +0000 and etc/images/icons/allout-widgets-light-bg/through-descender.png 2011-02-16 22:10:43 +0000 differ === added file 'etc/images/icons/allout-widgets-light-bg/through-descender.xpm' --- etc/images/icons/allout-widgets-light-bg/through-descender.xpm 1970-01-01 00:00:00 +0000 +++ etc/images/icons/allout-widgets-light-bg/through-descender.xpm 2011-02-16 22:10:43 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 21:29:32 +0000 +++ lisp/ChangeLog 2011-02-16 22:10:43 +0000 @@ -1,5 +1,9 @@ 2011-02-16 Ken Manheimer + * allout-widgets.el: New allout extension that shows allout + outline structure with graphical widgets. 'allout-widgets' + customize group is an 'allout' subgroup, for easy discovery. + * allout.el: Include PGP and GnuPG in Keywords, and other commentary refinements. (allout-abbreviate-flattened-numbering): Rename to === added file 'lisp/allout-widgets.el' --- lisp/allout-widgets.el 1970-01-01 00:00:00 +0000 +++ lisp/allout-widgets.el 2011-02-16 22:10:43 +0000 @@ -0,0 +1,2365 @@ +;; allout-widgets.el --- Show allout outline structure with graphical widgets. + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer + +;; Author: Ken Manheimer +;; Maintainer: Ken Manheimer +;; Version: 1.0 +;; Created: Dec 2005 +;; Version: 1.0 +;; Keywords: outlines +;; Website: http://myriadicity.net/Sundry/EmacsAllout + +;;; Commentary: + +;; This is an allout outline-mode add-on that highlights outline structure +;; with graphical widgets. +;; +;; To activate, customize `allout-widgets-auto-activation'. You can also +;; invoke allout-widgets-mode in a particular allout buffer. When +;; auto-enabled, you can inhibit widget operation in particular allout +;; buffers by setting the variable `allout-widgets-mode-inhibit' non-nil in +;; that file's buffer. Use emacs *file local variables* to generally +;; inhibit for a file. +;; +;; See the `allout-widgets-mode' docstring for more details. +;; +;; Info about allout and allout-widgets development are available at +;; http://myriadicity.net/Sundry/EmacsAllout +;; +;; The graphics include: +;; +;; - icons for item bullets, varying to distinguish whether the item either +;; lacks any subitems, the subitems are currently collapsed within the +;; item, or the item is currently expanded. +;; +;; - guide lines connecting item bullet-icons with those of their subitems. +;; +;; - cue area between the bullet-icon and the start of the body headline, +;; for item numbering, encryption indicator, and distinctive bullets. +;; +;; The bullet-icon and guide line graphics provide keybindings and mouse +;; bindings for easy outline navigation and exposure control, extending +;; outline hot-spot navigation (see `allout-mode' docstring for details). +;; +;; Developers note: Our use of emacs widgets is unconventional. We +;; decorate existing text rather than substituting for it, to +;; piggy-back on existing allout operation. This employs the C-coded +;; efficiencies of widget-apply, widget-get, and widget-put, along +;; with the basic object-oriented organization of widget-create, to +;; systematically couple overlays, graphics, and other features with +;; allout-governed text. + +;;;_: Code (structured with comments that delinieate an allout outline) + +;;;_ : General Environment +(require 'allout) +(require 'widget) +(require 'wid-edit) + +(eval-when-compile + (progn + (require 'overlay) + (require 'cl) + )) + +;;;_ : internal variables needed before user-customization variables +;;; In order to enable activation of allout-widgets-mode via customization, +;;; allout-widgets-auto-activation uses a setting function. That function +;;; is invoked when the customization variable definition is evaluated, +;;; during file load, so the involved code must reside above that +;;; definition in the file. +;;;_ = allout-widgets-mode +(defvar allout-widgets-mode nil + "Allout mode enhanced with graphical widgets.") +(make-variable-buffer-local 'allout-widgets-mode) + +;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions: +;;;_ > defgroup allout-widgets +;;;###autoload +(defgroup allout-widgets nil + "Allout extension that highlights outline structure graphically. + +Customize `allout-widgets-auto-activation' to activate allout-widgets +with allout-mode." + :group 'allout) +;;;_ > defgroup allout-widgets-developer +(defgroup allout-widgets-developer nil + "Settings for development of allout widgets extension." + :group 'allout-widgets) +;;;_ ; some functions a bit early, for allout-auto-activation dependency: +;;;_ > allout-widgets-mode-enable +(defun allout-widgets-mode-enable () + "Enable allout-widgets-mode in allout-mode buffers. + +See `allout-widgets-mode-inhibit' for per-file/per-buffer +inhibition of allout-widgets-mode." + (add-hook 'allout-mode-off-hook 'allout-widgets-mode-off) + (add-hook 'allout-mode-on-hook 'allout-widgets-mode-on) + t) +;;;_ > allout-widgets-mode-disable +(defun allout-widgets-mode-disable () + "Disable allout-widgets-mode in allout-mode buffers. + +See `allout-widgets-mode-inhibit' for per-file/per-buffer +inhibition of allout-widgets-mode." + (remove-hook 'allout-mode-off-hook 'allout-widgets-mode-off) + (remove-hook 'allout-mode-on-hook 'allout-widgets-mode-on) + t) +;;;_ > allout-widgets-setup (varname value) +;;;###autoload +(defun allout-widgets-setup (varname value) + "Commission or decommision allout-widgets-mode along with allout-mode. + +Meant to be used by customization of `allout-widgets-auto-activation'." + (set-default varname value) + (if allout-widgets-auto-activation + (allout-widgets-mode-enable) + (allout-widgets-mode-disable))) +;;;_ = allout-widgets-auto-activation +;;;###autoload +(defcustom allout-widgets-auto-activation nil + "Activate to enable allout icon graphics wherever allout mode is active. + +Also enable `allout-auto-activation' for this to take effect upon +visiting an outline. + +When this is set you can disable allout widgets in select files +by setting `allout-widgets-mode-inhibit' + +Instead of setting `allout-widgets-auto-activation' you can +explicitly invoke `allout-widgets-mode' in allout buffers where +you want allout widgets operation. + +See `allout-widgets-mode' for allout widgets mode features." + :type 'boolean + :group 'allout-widgets + :set 'allout-widgets-setup + ) +;; ;;;_ = allout-widgets-allow-unruly-edits +;; (defcustom allout-widgets-allow-unruly-edits nil +;; "*Control whether manual edits are restricted to maintain outline integrity. + +;; When nil, manual edits must either be within an item's body or encompass +;; one or more items completely - eg, killing topics as entities, rather than +;; deleting from the middle of one to the middle of another. + +;; If you only occasionally need to make unrestricted change, you can set this +;; variable in the specific buffer using set-variable, or just deactivate +;; `allout-mode' temporarily. You can customize this to always allow unruly +;; edits, but you will be able to create outlines that are unnavigable in +;; principle, and not just for allout's navigation and exposure mechanisms." +;; :type 'boolean +;; :group allout-widgets) +;; (make-variable-buffer-local 'allout-widgets-allow-unruly-edits) +;;;_ = allout-widgets-auto-activation - below, for eval-order dependencies +;;;_ = allout-widgets-icons-dark-subdir +(defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets-dark-bg/" + "Directory on `image-load-path' holding allout icons for dark backgrounds." + :type 'string + :group 'allout-widgets) +;;;_ = allout-widgets-icons-light-subdir +(defcustom allout-widgets-icons-light-subdir "icons/allout-widgets-light-bg/" + "Directory on `image-load-path' holding allout icons for light backgrounds." + :type 'string + :group 'allout-widgets) +;;;_ = allout-widgets-icon-types +(defcustom allout-widgets-icon-types '(xpm png) + "File extensions for the icon graphic format types, in order of preference." + :type '(repeat symbol) + :group 'allout-widgets) + +;;;_ . Decoration format +;;;_ = allout-widgets-theme-dark-background +(defcustom allout-widgets-theme-dark-background "allout-dark-bg" + "Identify the outline's icon theme to use with a dark background." + :type '(string) + :group 'allout-widgets) +;;;_ = allout-widgets-theme-light-background +(defcustom allout-widgets-theme-light-background "allout-light-bg" + "Identify the outline's icon theme to use with a light background." + :type '(string) + :group 'allout-widgets) +;;;_ = allout-widgets-item-image-properties-emacs +(defcustom allout-widgets-item-image-properties-emacs + '(:ascent center :mask (heuristic t)) + "*Default properties item widget images in mainline Emacs." + :type 'plist + :group 'allout-widgets) +;;;_ = allout-widgets-item-image-properties-xemacs +(defcustom allout-widgets-item-image-properties-xemacs + nil + "*Default properties item widget images in XEmacs." + :type 'plist + :group 'allout-widgets) +;;;_ . Developer +;;;_ = allout-widgets-run-unit-tests-on-load +(defcustom allout-widgets-run-unit-tests-on-load nil + "*When non-nil, unit tests will be run at end of loading allout-widgets. + +Generally, allout widgets code developers are the only ones who'll want to +set this. + +\(If set, this makes it an even better practice to exercise changes by +doing byte-compilation with a repeat count, so the file is loaded after +compilation.) + +See `allout-widgets-run-unit-tests' to see what's run." + :type 'boolean + :group 'allout-widgets-developer) +;;;_ = allout-widgets-time-decoration-activity +(defcustom allout-widgets-time-decoration-activity nil + "*Retain timing info of the last cooperative redecoration. + +The details are retained as the value of +`allout-widgets-last-decoration-timing'. + +Generally, allout widgets code developers are the only ones who'll want to +set this." + :type 'boolean + :group 'allout-widgets-developer) +;;;_ = allout-widgets-hook-error-post-time 0 +(defcustom allout-widgets-hook-error-post-time 0 + "*Amount of time to sit showing hook error messages. + +0 is minimal, or nil to not post to the message area. + +This is for debugging purposes." + :type 'integer + :group 'allout-widgets-developer) +;;;_ = allout-widgets-maintain-tally nil +(defcustom allout-widgets-maintain-tally nil + "*If non-nil, maintain a collection of widgets, `allout-widgets-tally'. + +This is for debugging purposes. + +The tally shows the total number of item widgets in the current +buffer, and tracking increases as new widgets are added and +decreases as obsolete widgets are garbage collected." + :type 'boolean + :group 'allout-widgets-developer) +(defvar allout-widgets-tally nil + "Hash-table of existing allout widgets, for debugging. + +Table is maintained iff `allout-widgets-maintain-tally' is non-nil. + +The table contents will be out of sync if any widgets are created +or deleted while this variable is nil.") +(make-variable-buffer-local 'allout-widgets-tally) +;;;_ > allout-widgets-tally-string +(defun allout-widgets-tally-string () + "Return a string giving the number of tracked widgets, or empty string if not tracking. + +The string is formed for appending to the allout-mode mode-line lighter. + +An empty string is also returned if tracking is inhibited or +widgets are locally inhibited. + +The number varies according to the evanescence of objects on a + hash table with weak keys, so tracking of widget erasures is often delayed." + (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit)) + (format ":%s" (hash-table-count allout-widgets-tally)))) +;;;_ = allout-widgets-track-decoration nil +(defcustom allout-widgets-track-decoration nil + "*If non-nil, show cursor position of each item decoration. + +This is for debugging purposes, and generally set at need in a +buffer rather than as a prevailing configuration \(but it's handy +to publicize it by making it a customization variable\)." + :type 'boolean + :group 'allout-widgets-developer) +(make-variable-buffer-local 'allout-widgets-track-decoration) + +;;;_ : Mode context - variables, hookup, and hooks +;;;_ . internal mode variables +;;;_ , Mode activation and environment +;;;_ = allout-widgets-version +(defvar allout-widgets-version "1.0" + "Version of currently loaded allout-widgets extension.") +;;;_ > allout-widgets-version +(defun allout-widgets-version (&optional here) + "Return string describing the loaded outline version." + (interactive "P") + (let ((msg (concat "Allout Outline Widgets Extension v " + allout-widgets-version))) + (if here (insert msg)) + (message "%s" msg) + msg)) +;;;_ = allout-widgets-mode-inhibit +(defvar allout-widgets-mode-inhibit nil + "Inhibit `allout-widgets-mode' from activating widgets. + +This also inhibits automatic adjustment of widgets to track allout outline +changes. + +You can use this as a file local variable setting to disable +allout widgets enhancements in selected buffers while generally +enabling widgets by customizing `allout-widgets-auto-activation'. + +In addition, you can invoked `allout-widgets-mode' allout-mode +buffers where this is set to enable and disable widget +enhancements, directly.") +;;;###autoload +(put 'allout-widgets-mode-inhibit 'safe-local-variable + (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) +(make-variable-buffer-local 'allout-widgets-mode-inhibit) +;;;_ = allout-inhibit-body-modification-hook +(defvar allout-inhibit-body-modification-hook nil + "Override de-escaping of text-prefixes in item bodies during specific changes. + +This is used by `allout-buffer-modification-handler' to signal such changes +to `allout-body-modification-handler', and is always reset by +`allout-post-command-business'.") +(make-variable-buffer-local 'allout-inhibit-body-modification-hook) +;;;_ = allout-widgets-icons-cache +(defvar allout-widgets-icons-cache nil + "Cache allout icon images, as an association list. + +`allout-fetch-icon-image' uses this cache transparently, keying +images with lists containing the name of the icon directory \(as +found on the `load-path') and the icon name. + +Set this variable to `nil' to empty the cache, and have it replenish from the +filesystem.") +;;;_ = allout-widgets-unset-inhibit-read-only +(defvar allout-widgets-unset-inhibit-read-only nil + "Tell `allout-widgets-post-command-business' to unset `inhibit-read-only'. + +Used by `allout-graphics-modification-handler'") +;;;_ = allout-widgets-reenable-before-change-handler +(defvar allout-widgets-reenable-before-change-handler nil + "Tell `allout-widgets-post-command-business' to reequip the handler. + +Necessary because the handler sometimes deliberately raises an +error, causing it to be disabled.") +;;;_ , State for hooks +;;;_ = allout-unresolved-body-mod-workroster +(defvar allout-unresolved-body-mod-workroster (make-hash-table :size 16) + "List of body-overlays that did before-change business but not after-change. + +See `allout-post-command-business' and `allout-body-modification-handler'.") +;;;_ = allout-structure-unruly-deletion-message +(defvar allout-structure-unruly-deletion-message + "Unruly edit prevented -- +To change the bullet character: \\[allout-rebullet-current-heading] +To promote this item: \\[allout-shift-out] +To demote it: \\[allout-shift-in] +To delete it and offspring: \\[allout-kill-topic] +See \\[describe-mode] for many more options." + "Informative message presented on improper editing of outline structure. + +The structure includes the guides lines, bullet, and bullet cue.") +;;;_ = allout-widgets-changes-record +(defvar allout-widgets-changes-record nil + "Record outline changes for processing by post-command hook. + +Entries on the list are lists whose first element is a symbol indicating +the change type and subsequent elements are data specific to that change +type. Specifically: + + 'exposure `allout-exposure-from' `allout-exposure-to' `allout-exposure-flag' + +The changes are recorded in reverse order, with new values pushed +onto the front.") +(make-variable-buffer-local 'allout-widgets-changes-record) +;;;_ = allout-widgets-undo-exposure-record +(defvar allout-widgets-undo-exposure-record nil + "Record outline undo traces for processing by post-command hook. + +The changes are recorded in reverse order, with new values pushed +onto the front.") +(make-variable-buffer-local 'allout-widgets-undo-exposure-record) +;;;_ = allout-widgets-last-hook-error +(defvar allout-widgets-last-hook-error nil + "String holding last error string, for debugging purposes.") +;;;_ = allout-widgets-adjust-message-length-threshold 100 +(defvar allout-widgets-adjust-message-length-threshold 100 + "Display \"Adjusting widgets\" message above this number of pending changes." + ) +;;;_ = allout-widgets-adjust-message-size-threshold 10000 +(defvar allout-widgets-adjust-message-size-threshold 10000 + "Display \"Adjusting widgets\" message above this size of pending changes." + ) +;;;_ = allout-doing-exposure-undo-processor nil +(defvar allout-undo-exposure-in-progress nil + "Maintained true during `allout-widgets-exposure-undo-processor'") +;;;_ , Widget-specific outline text format +;;;_ = allout-escaped-prefix-regexp +(defvar allout-escaped-prefix-regexp "" + "*Regular expression for body text that would look like an item prefix if +not altered with an escape sequence.") +(make-variable-buffer-local 'allout-escaped-prefix-regexp) +;;;_ , Widget element formatting +;;;_ = allout-item-icon-keymap +(defvar allout-item-icon-keymap + (let ((km (make-sparse-keymap))) + (dolist (digit '("0" "1" "2" "3" + "4" "5" "6" "7" "8" "9")) + (define-key km digit 'digit-argument)) + (define-key km "-" 'negative-argument) +;; (define-key km [(return)] 'allout-tree-expand-command) +;; (define-key km [(meta return)] 'allout-toggle-torso-command) +;; (define-key km [(down-mouse-1)] 'allout-item-button-click) +;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command) + ;; Override underlying mouse-1 and mouse-2 bindings in icon territory: + (define-key km [(mouse-1)] (lambda () (interactive) nil)) + (define-key km [(mouse-2)] (lambda () (interactive) nil)) + + ;; Catchall, handles actual keybindings, dynamically doing keymap lookups: + (define-key km [t] 'allout-item-icon-key-handler) + + km) + "General tree-node key bindings.") +;;;_ = allout-item-body-keymap +(defvar allout-item-body-keymap + (let ((km (make-sparse-keymap)) + (local-map (current-local-map))) +;; (define-key km [(control return)] 'allout-tree-expand-command) +;; (define-key km [(meta return)] 'allout-toggle-torso-command) + ;; XXX We need to reset this per buffer's mode; we do so in + ;; allout-widgets-mode. + (if local-map + (set-keymap-parent km local-map)) + + km) + "General key bindings for the text content of outline items.") +(make-variable-buffer-local 'allout-item-body-keymap) +;;;_ = allout-body-span-category +(defvar allout-body-span-category nil + "Symbol carrying allout body-text overlay properties.") +;;;_ = allout-cue-span-keymap +(defvar allout-cue-span-keymap + (let ((km (make-sparse-keymap))) + (set-keymap-parent km allout-item-icon-keymap) + km) + "Keymap used in the item cue area - the space between the icon and headline.") +;;;_ = allout-escapes-category +(defvar allout-escapes-category nil + "Symbol for category of text property used to hide escapes of prefix-like +text in allout item bodies.") +;;;_ = allout-guides-category +(defvar allout-guides-category nil + "Symbol carrying allout icon-guides overlay properties.") +;;;_ = allout-guides-span-category +(defvar allout-guides-span-category nil + "Symbol carrying allout icon and guide lines overlay properties.") +;;;_ = allout-icon-span-category +(defvar allout-icon-span-category nil + "Symbol carrying allout icon and guide lines overlay properties.") +;;;_ = allout-cue-span-category +(defvar allout-cue-span-category nil + "Symbol carrying common properties of the space following the outline icon. + +\(That space is used to convey selected cues indicating body qualities, +including things like: + - encryption '~' + - numbering '#' + - indirect reference '@' + - distinctive bullets - see `allout-distinctive-bullets-string'.\)") +;;;_ = allout-span-to-category +(defvar allout-span-to-category + '((:guides-span . allout-guides-span-category) + (:cue-span . allout-cue-span-category) + (:icon-span . allout-icon-span-category) + (:body-span . allout-body-span-category)) + "Association list mapping span identifier to category identifier.") +;;;_ = allout-trailing-category +(defvar allout-trailing-category nil + "Symbol carrying common properties of an overlay's trailing newline.") +;;;_ , Developer +(defvar allout-widgets-last-decoration-timing nil + "Timing details for the last cooperative decoration action. + +This is maintained when `allout-widgets-time-decoration-activity' is set. + +The value is a list containing two elements: + - the elapsed time as a number of seconds + - the list of changes processed, a la `allout-widgets-changes-record'. + +When active, the value is revised each time automatic decoration activity +happens in the buffer.") +(make-variable-buffer-local 'allout-widgets-last-decoration-timing) +;;;_ . mode hookup +;;;_ > define-minor-mode allout-widgets-mode (arg) +;;;###autoload +(define-minor-mode allout-widgets-mode + "Allout-mode extension, providing graphical decoration of outline structure. + +This is meant to operate along with allout-mode, via `allout-mode-hook'. + +If optional argument ARG is greater than 0, enable. +If optional argument ARG is less than 0, disable. +Anything else, toggle between active and inactive. + +The graphics include: + +- guide lines connecting item bullet-icons with those of their subitems. + +- icons for item bullets, varying to indicate whether or not the item + has subitems, and if so, whether or not the item is expanded. + +- cue area between the bullet-icon and the start of the body headline, + for item numbering, encryption indicator, and distinctive bullets. + +The bullet-icon and guide line graphics provide keybindings and mouse +bindings for easy outline navigation and exposure control, extending +outline hot-spot navigation \(see `allout-mode')." + + :lighter nil + :keymap nil + + ;; define-minor-mode handles any provided argument according to emacs + ;; minor-mode conventions - '(elisp) Minor Mode Conventions' - and sets + ;; allout-widgets-mode accordingly *before* running the body code, so we + ;; cue on that. + (if allout-widgets-mode + ;; Activating: + (progn + (allout-add-resumptions + ;; XXX user may need say in line-truncation/hscrolling - an option + ;; that abstracts mode. + ;; truncate text lines to keep guide lines intact: + '(truncate-lines t) + ;; and enable autoscrolling to ease view of text + '(auto-hscroll-mode t) + '(line-move-ignore-fields t) + '(widget-push-button-prefix "") + '(widget-push-button-suffix "") + ;; allout-escaped-prefix-regexp depends on allout-regexp: + (list 'allout-escaped-prefix-regexp (concat "\\(\\\\\\)" + "\\(" allout-regexp "\\)"))) + (allout-add-resumptions + (list 'allout-widgets-tally allout-widgets-tally) + (list 'allout-widgets-escapes-sanitization-regexp-pair + (list (concat "\\(\n\\|\\`\\)" + allout-escaped-prefix-regexp + ) + ;; Include everything but the escape symbol. + "\\1\\3")) + ) + + (add-hook 'after-change-functions 'allout-widgets-after-change-handler + nil t) + + (allout-setup-text-properties) + (add-to-invisibility-spec '(allout-torso . t)) + (add-to-invisibility-spec 'allout-escapes) + + (if (current-local-map) + (set-keymap-parent allout-item-body-keymap (current-local-map))) + + (add-hook 'allout-exposure-change-hook + 'allout-widgets-exposure-change-recorder nil 'local) + (add-hook 'allout-structure-added-hook + 'allout-widgets-additions-recorder nil 'local) + (add-hook 'allout-structure-deleted-hook + 'allout-widgets-deletions-recorder nil 'local) + (add-hook 'allout-structure-shifted-hook + 'allout-widgets-shifts-recorder nil 'local) + (add-hook 'allout-after-copy-or-kill-hook + 'allout-widgets-after-copy-or-kill-function nil 'local) + + (add-hook 'before-change-functions 'allout-widgets-before-change-handler + nil 'local) + (add-hook 'post-command-hook 'allout-widgets-post-command-business + nil 'local) + (add-hook 'pre-command-hook 'allout-widgets-pre-command-business + nil 'local) + + ;; init the widgets tally for debugging: + (if (not allout-widgets-tally) + (setq allout-widgets-tally (make-hash-table + :test 'eq :weakness 'key))) + ;; add tally count display on minor-mode-alist just after + ;; allout-mode entry. + ;; (we use ternary condition form to keep condition simple for deletion.) + (let* ((mode-line-entry '(allout-widgets-mode-inhibit "" + (:eval (allout-widgets-tally-string)))) + (associated (assoc (car mode-line-entry) minor-mode-alist)) + ;; need location for it only if not already present: + (after (and (not associated) + (memq (assq 'allout-mode minor-mode-alist) minor-mode-alist)))) + (if after + (rplacd after (cons mode-line-entry (cdr after))))) + (allout-widgets-prepopulate-buffer) + t) + ;; Deactivating: + (let ((inhibit-read-only t) + (was-modified (buffer-modified-p))) + + (allout-widgets-undecorate-region (point-min)(point-max)) + (remove-from-invisibility-spec '(allout-torso . t)) + (remove-from-invisibility-spec 'allout-escapes) + + (remove-hook 'after-change-functions + 'allout-widgets-after-change-handler 'local) + (remove-hook 'allout-exposure-change-hook + 'allout-widgets-exposure-change-recorder 'local) + (remove-hook 'allout-structure-added-hook + 'allout-widgets-additions-recorder 'local) + (remove-hook 'allout-structure-deleted-hook + 'allout-widgets-deletions-recorder 'local) + (remove-hook 'allout-structure-shifted-hook + 'allout-widgets-shifts-recorder 'local) + (remove-hook 'allout-after-copy-or-kill-hook + 'allout-widgets-after-copy-or-kill-function 'local) + (remove-hook 'before-change-functions + 'allout-widgets-before-change-handler 'local) + (remove-hook 'post-command-hook + 'allout-widgets-post-command-business 'local) + (remove-hook 'pre-command-hook + 'allout-widgets-pre-command-business 'local) + (assq-delete-all 'allout-widgets-mode-inhibit minor-mode-alist) + (set-buffer-modified-p was-modified)))) +;;;_ > allout-widgets-mode-off +(defun allout-widgets-mode-off () + "Explicitly disable allout-widgets-mode." + (allout-widgets-mode -1)) +;;;_ > allout-widgets-mode-off +(defun allout-widgets-mode-on () + "Explicitly disable allout-widgets-mode." + (allout-widgets-mode 1)) +;;;_ > allout-setup-text-properties () +(defun allout-setup-text-properties () + "Configure category and literal text properties." + + ;; XXX body - before-change, entry, keymap + + (setplist 'allout-guides-span-category nil) + (put 'allout-guides-span-category + 'modification-hooks '(allout-graphics-modification-handler)) + (put 'allout-guides-span-category 'local-map allout-item-icon-keymap) + (put 'allout-guides-span-category 'mouse-face widget-button-face) + (put 'allout-guides-span-category 'field 'structure) +;; (put 'allout-guides-span-category 'face 'widget-button) + + (setplist 'allout-icon-span-category + (allout-widgets-copy-list (symbol-plist + 'allout-guides-span-category))) + (put 'allout-icon-span-category 'field 'structure) + + ;; XXX for body text we're instead going to use the buffer-wide + ;; resources, like before/after-change-functions hooks and the + ;; buffer's key map. that way we won't have to do painful provisions + ;; to fixup things after edits, catch outlier interstitial + ;; characters, like newline and empty lines after hidden subitems, + ;; etc. + (setplist 'allout-body-span-category nil) + (put 'allout-body-span-category 'evaporate t) + (put 'allout-body-span-category 'local-map allout-item-body-keymap) + ;;(put 'allout-body-span-category + ;; 'modification-hooks '(allout-body-modification-handler)) + ;;(put 'allout-body-span-category 'field 'body) + + (setplist 'allout-cue-span-category nil) + (put 'allout-cue-span-category 'evaporate t) + (put 'allout-cue-span-category + 'modification-hooks '(allout-body-modification-handler)) + (put 'allout-cue-span-category 'local-map allout-cue-span-keymap) + (put 'allout-cue-span-category 'mouse-face widget-button-face) + (put 'allout-cue-span-category 'pointer 'arrow) + (put 'allout-cue-span-category 'field 'structure) + + (setplist 'allout-trailing-category nil) + (put 'allout-trailing-category 'evaporate t) + (put 'allout-trailing-category 'local-map allout-item-body-keymap) + + (setplist 'allout-escapes-category nil) + (put 'allout-escapes-category 'invisible 'allout-escapes) + (put 'allout-escapes-category 'evaporate t)) +;;;_ > allout-widgets-prepopulate-buffer () +(defun allout-widgets-prepopulate-buffer () + "Step over the current buffers exposed items to do initial widgetizing." + (if (not allout-widgets-mode-inhibit) + (save-excursion + (goto-char (point-min)) + (while (allout-next-visible-heading 1) + (when (not (widget-at (point))) + (allout-get-or-create-item-widget)))))) +;;;_ . settings context +;;;_ = allout-container-item +(defvar allout-container-item-widget nil + "A widget for the current outline's overarching container as an item. + +The item has settings \(of the file/connection\) and maybe a body, but no +icon/bullet.") +(make-variable-buffer-local 'allout-container-item-widget) +;;;_ . Hooks and hook helpers +;;;_ , major command-loop business: +;;;_ > allout-widgets-pre-command-business (&optional recursing) +(defun allout-widgets-pre-command-business (&optional recursing) + "Handle actions pending before allout-mode activity." +) +;;;_ > allout-widgets-post-command-business (&optional recursing) +(defun allout-widgets-post-command-business (&optional recursing) + "Handle actions pending after any allout-mode commands. + +Optional RECURSING is for internal use, to limit recursion." + ;; - check changed text for nesting discontinuities and escape anything + ;; that's: (1) asterisks at bol or (2) excessively nested. + (condition-case failure + + (when (and (boundp 'allout-mode) allout-mode) + + (if allout-widgets-unset-inhibit-read-only + (setq inhibit-read-only nil + allout-widgets-unset-inhibit-read-only nil)) + + (when allout-widgets-reenable-before-change-handler + (add-hook 'before-change-functions + 'allout-widgets-before-change-handler + nil 'local) + (setq allout-widgets-reenable-before-change-handler nil)) + + (when (or allout-widgets-undo-exposure-record + allout-widgets-changes-record) + (let* ((debug-on-signal t) + (debug-on-error t) + ;; inhibit recording new undo records when processing + ;; effects of undo-exposure: + (debugger 'allout-widgets-hook-error-handler) + (adjusting-message " Adjusting widgets...") + (replaced-message (allout-widgets-adjusting-message + adjusting-message)) + (start-time (current-time))) + + (if allout-widgets-undo-exposure-record + ;; inhibit undo recording iff undoing exposure stuff. + ;; XXX we might need to inhibit per respective + ;; change-record, rather than assuming that some undo + ;; activity during a command is all undo activity. + (let ((buffer-undo-list t)) + (allout-widgets-exposure-undo-processor) + (allout-widgets-changes-dispatcher)) + (allout-widgets-exposure-undo-processor) + (allout-widgets-changes-dispatcher)) + + (if allout-widgets-time-decoration-activity + (setq allout-widgets-last-decoration-timing + (list (allout-elapsed-time-seconds (current-time) + start-time) + allout-widgets-changes-record))) + + (setq allout-widgets-changes-record nil) + + (if replaced-message + (if (stringp replaced-message) + (message replaced-message) + (message ""))))) + + ;; Detect undecorated items, eg during isearch into previously + ;; unexposed topics, and decorate "economically". Some + ;; undecorated stuff is often exposed, to reduce lag, but the + ;; item containing the cursor is decorated. We constrain + ;; recursion to avoid being trapped by unexpectedly undecoratable + ;; items. + (when (and (not recursing) + (not (allout-current-decorated-p)) + (or (not (equal (allout-depth) 0)) + (not allout-container-item-widget))) + (let ((buffer-undo-list t)) + (allout-widgets-exposure-change-recorder + allout-recent-prefix-beginning allout-recent-prefix-end nil) + (allout-widgets-post-command-business 'recursing))) + + ;; Detect and rectify fouled outline structure - decorated item + ;; not at beginning of line. + (let ((this-widget (or (widget-at (point)) + ;; XXX we really should be checking across + ;; edited span, not just point and point+1 + (and (not (eq (point) (point-max))) + (widget-at (1+ (point)))))) + inserted-at) + (save-excursion + (if (and this-widget + (goto-char (widget-get this-widget :from)) + (not (bolp))) + (if (not + (condition-case err + (yes-or-no-p + (concat "Misplaced item won't be recognizable " + " as part of outline - rectify? ")) + (quit nil))) + (progn + (if (allout-hidden-p (max (1- (point)) 1)) + (save-excursion + (goto-char (max (1- (point)) 1)) + (allout-show-to-offshoot))) + (allout-widgets-undecorate-item this-widget)) + ;; expose any hidden intervening items, so resulting + ;; position is clear: + (setq inserted-at (point)) + (allout-unprotected (insert-before-markers "\n")) + (forward-char -1) + ;; ensure the inserted newline is visible: + (allout-flag-region inserted-at (1+ inserted-at) nil) + (allout-widgets-post-command-business 'recursing) + (message (concat "outline structure corrected - item" + " moved to beginning of new line")) + ;; preserve cursor position in some cases: + (if (and inserted-at + (> (point) inserted-at)) + (forward-char -1))))))) + + (error + ;; zero work list so we don't get stuck futily retrying. + ;; error recording done by allout-widgets-hook-error-handler. + (setq allout-widgets-changes-record nil)))) +;;;_ , major change handlers: +;;;_ > allout-widgets-before-change-handler +(defun allout-widgets-before-change-handler (beg end) + "Business to be done before changes in a widgetized allout outline." + ;; protect against unruly edits to structure: + (cond + (undo-in-progress (when (eq (get-text-property beg 'category) + 'allout-icon-span-category) + (save-excursion + (goto-char beg) + (let* ((item-widget (allout-get-item-widget))) + (if item-widget + (allout-widgets-exposure-undo-recorder + item-widget)))))) + (inhibit-read-only t) + ((not (and (boundp 'allout-mode) allout-mode)) t) + ((equal this-command 'quoted-insert) t) + ((not (text-property-any beg (if (equal end beg) + (min (1+ beg) (point-max)) + end) + 'field 'structure)) + t) + ((yes-or-no-p "Unruly edit of outline structure - allow? ") + (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only) + inhibit-read-only t)) + (t + ;; tell the allout-widgets-post-command-business to reestablish the hook: + (setq allout-widgets-reenable-before-change-handler t) + ;; and raise an error to prevent the edit (and disable the hook): + (error + (substitute-command-keys allout-structure-unruly-deletion-message))))) +;;;_ > allout-widgets-after-change-handler +(defun allout-widgets-after-change-handler (beg end prelength) + "Reconcile what needs to be reconciled for allout widgets after edits." + ) +;;;_ > allout-current-decorated-p () +(defun allout-current-decorated-p () + "True if the current item is not decorated" + (save-excursion + (if (allout-back-to-current-heading) + (if (> allout-recent-depth 0) + (and (allout-get-item-widget) t) + allout-container-item-widget)))) + +;;;_ > allout-widgets-hook-error-handler +(defun allout-widgets-hook-error-handler (mode args) + "Process errors which occurred in the course of command hook operation. + +We store a backtrace of the error information in the variable, +`allout-widgets-last-hook-error', unset the error handlers, and +reraise the error, so that processing continues to the +encompassing condition-case." + ;; first deconstruct special error environment so errors here propagate + ;; to encompassing condition-case: + (setq debugger 'debug + debug-on-error nil + debug-on-signal nil) + (let* ((bt (with-output-to-string (backtrace))) + (this "allout-widgets-hook-error-handler") + (header + (format "allout-widgets-last-hook-error stored, %s/%s %s %s" + this mode args + (format-time-string "%e-%b-%Y %r" (current-time))))) + ;; post to *Messages* then immediately replace with more compact notice: + (message "%s" (setq allout-widgets-last-hook-error + (format "%s:\n%s" header bt))) + (message header) (sit-for allout-widgets-hook-error-post-time) + ;; reraise the error, or one concerning this function if unexpected: + (if (equal mode 'error) + (apply 'signal args) + (error "%s: unexpected mode, %s %s" this mode args)))) +;;;_ > allout-widgets-changes-exceed-threshold-p () +(defun allout-widgets-adjusting-message (message) + "Post MESSAGE when pending are likely to make a big enough delay. + +If posting of the MESSAGE is warranted and there already is a +`current-message' in the minibuffer, the MESSAGE is appended to +the current one, and the previously pending `current-message' is +returned for later posting on completion. + +If posting of the MESSAGE is warranted, but no `current-message' +is pending, then t is returned to indicate that case. + +If posting of the MESSAGE is not warranted, then nil is returned. + +See `allout-widgets-adjust-message-length-threshold', +`allout-widgets-adjust-message-size-threshold' for message +posting threshold criteria." + (if (or (> (length allout-widgets-changes-record) + allout-widgets-adjust-message-length-threshold) + ;; for size, use distance from start of first to end of last: + (let ((min (point-max)) + (max 0) + first second) + (mapc (function (lambda (entry) + (if (eq :undone-exposure (car entry)) + nil + (setq first (cadr entry) + second (caddr entry)) + (if (< (min first second) min) + (setq min (min first second))) + (if (> (max first second) max) + (setq max (max first second)))))) + allout-widgets-changes-record) + (> (- max min) allout-widgets-adjust-message-size-threshold))) + (let ((prior (current-message))) + (message (if prior (concat prior " - " message) message)) + (or prior t)))) +;;;_ > allout-widgets-changes-dispatcher () +(defun allout-widgets-changes-dispatcher () + "Dispatch CHANGES-RECORD items to respective widgets change processors." + + (if (not allout-widgets-mode-inhibit) + (let* ((changes-record allout-widgets-changes-record) + (changes-pending (and changes-record t)) + entry + exposures + additions + deletions + shifts) + + (when changes-pending + (while changes-record + (setq entry (pop changes-record)) + (case (car entry) + (:exposed (push entry exposures)) + (:added (push entry additions)) + (:deleted (push entry deletions)) + (:shifted (push entry shifts)))) + + (if exposures + (allout-widgets-exposure-change-processor exposures)) + (if additions + (allout-widgets-additions-processor additions)) + (if deletions + (allout-widgets-deletions-processor deletions)) + (if shifts + (allout-widgets-shifts-processor shifts)))) + (when (not (equal allout-widgets-mode-inhibit 'undecorated)) + (allout-widgets-undecorate-region (point-min)(point-max)) + (setq allout-widgets-mode-inhibit 'undecorated)))) +;;;_ > allout-widgets-exposure-change-recorder (from to flag) +(defun allout-widgets-exposure-change-recorder (from to flag) + "Record allout exposure changes for tracking during post-command processing. + +Records changes in `allout-widgets-changes-record'." + (push (list :exposed from to flag) allout-widgets-changes-record)) +;;;_ > allout-widgets-exposure-change-processor (changes) +(defun allout-widgets-exposure-change-processor (changes) + "Widgetize and adjust item widgets tracking allout outline exposure changes. + +Generally invoked via `allout-exposure-change-hook'." + + (let ((changes (sort changes (function (lambda (this next) + (< (cadr this) (cadr next)))))) + ;; have to distinguish between concealing and exposing so that, eg, + ;; `allout-expose-topic's mix is handled properly. + handled-expose + handled-conceal + covered + deactivate-mark) + + (dolist (change changes) + (let (handling + (from (cadr change)) + bucket got + (to (caddr change)) + (flag (cadddr change)) + parent) + + ;; swap from and to: + (if (< to from) (setq bucket to + to from + from bucket)) + + ;; have we already handled exposure changes in this region? + (setq handling (if flag 'handled-conceal 'handled-expose) + got (allout-range-overlaps from to (symbol-value handling)) + covered (car got)) + (set handling (cadr got)) + + (when (not covered) + (save-excursion + (goto-char from) + (cond + + ;; collapsing: + (flag + (allout-widgets-undecorate-region from to) + (allout-beginning-of-current-line) + (let ((widget (allout-get-item-widget))) + (if (not widget) + (allout-get-or-create-item-widget) + (widget-apply widget :redecorate)))) + + ;; expanding: + (t + (while (< (point) to) + (allout-beginning-of-current-line) + (setq parent (allout-get-item-widget)) + (if (not parent) + (setq parent (allout-get-or-create-item-widget)) + (widget-apply parent :redecorate)) + (allout-next-visible-heading 1) + (if (widget-get parent :has-subitems) + (allout-redecorate-visible-subtree parent)) + (if (> (point) to) + ;; subtree may be well beyond to - incorporate in ranges: + (setq handled-expose + (allout-range-overlaps from (point) handled-expose) + covered (car handled-expose) + handled-expose (cadr handled-expose))) + (allout-next-visible-heading 1)))))))))) + +;;;_ > allout-widgets-additions-recorder (from to) +(defun allout-widgets-additions-recorder (from to) + "Record allout item additions for tracking during post-command processing. + +Intended for use on `allout-structure-added-hook'. + +FROM point at the start of the first new item and TO is point at the start +of the last one. + +Records changes in `allout-widgets-changes-record'." + (push (list :added from to) allout-widgets-changes-record)) +;;;_ > allout-widgets-additions-processor (changes) +(defun allout-widgets-additions-processor (changes) + "Widgetize and adjust items tracking allout outline structure additions. + +Dispatched by `allout-widgets-post-command-business' in response to +:added entries recorded by `allout-widgets-additions-recorder'." + (save-excursion + (let (handled + covered) + (dolist (change changes) + (let ((from (cadr change)) + bucket + (to (caddr change))) + (if (< to from) (setq bucket to to from from bucket)) + ;; have we already handled exposure changes in this region? + (setq handled (allout-range-overlaps from to handled) + covered (car handled) + handled (cadr handled)) + (when (not covered) + (goto-char from) + ;; Prior sibling and parent can both be affected. + (if (allout-ascend) + (allout-redecorate-visible-subtree + (allout-get-or-create-item-widget 'redecorate))) + (if (< (point) from) + (goto-char from)) + (while (and (< (point) to) (not (eobp))) + (allout-beginning-of-current-line) + (allout-redecorate-visible-subtree + (allout-get-or-create-item-widget)) + (allout-next-visible-heading 1)) + (if (> (point) to) + ;; subtree may be well beyond to - incorporate in ranges: + (setq handled (allout-range-overlaps from (point) handled) + covered (car handled) + handled (cadr handled))))))))) + +;;;_ > allout-widgets-deletions-recorder (depth from) +(defun allout-widgets-deletions-recorder (depth from) + "Record allout item deletions for tracking during post-command processing. + +Intended for use on `allout-structure-deleted-hook'. + +DEPTH is the depth of the deleted subtree, and FROM is the point from which +the subtree was deleted. + +Records changes in `allout-widgets-changes-record'." + (push (list :deleted depth from) allout-widgets-changes-record)) +;;;_ > allout-widgets-deletions-processor (changes) +(defun allout-widgets-deletions-processor (changes) + "Adjust items tracking allout outline structure deletions. + +Dispatched by `allout-widgets-post-command-business' in response to +:deleted entries recorded by `allout-widgets-deletions-recorder'." + (save-excursion + (dolist (change changes) + (let ((depth (cadr change)) + (from (caddr change))) + (goto-char from) + (when (allout-previous-visible-heading 1) + (if (> depth 1) + (allout-ascend-to-depth (1- depth))) + (allout-redecorate-visible-subtree + (allout-get-or-create-item-widget 'redecorate))))))) + +;;;_ > allout-widgets-shifts-recorder (shifted-amount at) +(defun allout-widgets-shifts-recorder (shifted-amount at) + "Record outline subtree shifts for tracking during post-command processing. + +Intended for use on `allout-structure-shifted-hook'. + +SHIFTED-AMOUNT is the depth change and AT is the point at the start of the +subtree that's been shifted. + +Records changes in `allout-widgets-changes-record'." + (push (list :shifted shifted-amount at) allout-widgets-changes-record)) +;;;_ > allout-widgets-shifts-processor (changes) +(defun allout-widgets-shifts-processor (changes) + "Widgetize and adjust items tracking allout outline structure additions. + +Dispatched by `allout-widgets-post-command-business' in response to +:shifted entries recorded by `allout-widgets-shifts-recorder'." + (save-excursion + (dolist (change changes) + (goto-char (caddr change)) + (allout-ascend) + (allout-redecorate-visible-subtree)))) +;;;_ > allout-widgets-after-copy-or-kill-function () +(defun allout-widgets-after-copy-or-kill-function () + "Do allout-widgets processing of text just placed in the kill ring. + +Intended for use on allout-after-copy-or-kill-hook." + (if (car kill-ring) + (setcar kill-ring (allout-widgets-undecorate-text (car kill-ring))))) + +;;;_ > allout-widgets-exposure-undo-recorder (widget from-state) +(defun allout-widgets-exposure-undo-recorder (widget) + "Record outline exposure undo for tracking during post-command processing. + +Intended for use by `allout-graphics-modification-handler'. + +WIDGET is the widget being changed. + +Records changes in `allout-widgets-changes-record'." + ;; disregard the events if we're currently processing them. + (if (not allout-undo-exposure-in-progress) + (push widget allout-widgets-undo-exposure-record))) +;;;_ > allout-widgets-exposure-undo-processor () +(defun allout-widgets-exposure-undo-processor () + "Adjust items tracking undo of allout outline structure exposure. + +Dispatched by `allout-widgets-post-command-business' in response to +:undone-exposure entries recorded by `allout-widgets-exposure-undo-recorder'." + (let* ((allout-undo-exposure-in-progress t) + ;; inhibit undo recording while twiddling exposure to track undo: + (widgets allout-widgets-undo-exposure-record) + widget widget-start-marker widget-end-marker + from-state icon-start-point to-state + handled covered) + (setq allout-widgets-undo-exposure-record nil) + (save-excursion + (dolist (widget widgets) + (setq widget-start-marker (widget-get widget :from) + widget-end-marker (widget-get widget :to) + from-state (widget-get widget :icon-state) + icon-start-point (widget-apply widget :actual-position + :icon-start) + to-state (get-text-property icon-start-point + :icon-state)) + (setq handled (allout-range-overlaps widget-start-marker + widget-end-marker + handled) + covered (car handled) + handled (cadr handled)) + (when (not covered) + (goto-char (widget-get widget :from)) + (when (not (allout-hidden-p)) + ;; adjust actual exposure to that of to-state viz from-state + (cond ((and (eq to-state 'closed) (eq from-state 'opened)) + (allout-hide-current-subtree) + (allout-decorate-item-and-context widget)) + ((and (eq to-state 'opened) (eq from-state 'closed)) + (save-excursion + (dolist + (expose-to (allout-chart-exposure-contour-by-icon)) + (goto-char expose-to) + (allout-show-to-offshoot))))))))))) +;;;_ > allout-chart-exposure-contour-by-icon (&optional from-depth) +(defun allout-chart-exposure-contour-by-icon (&optional from-depth) + "Return points of subtree items to which exposure should be extended. + +The qualifying items are ones with a widget icon that is in the closed or +empty state, or items with undecorated subitems. + +The resulting list of points is in reverse order. + +Optional FROM-DEPTH is for internal use." + ;; During internal recursion, we return a pair: (at-end . result) + ;; Otherwise we just return the result. + (let ((from-depth from-depth) + start-point + at-end level-depth + this-widget + got subgot) + (if from-depth + (setq level-depth (allout-depth)) + ;; at containing item: + (setq start-point (point)) + (setq from-depth (allout-depth)) + (setq at-end (not (allout-next-heading)) + level-depth allout-recent-depth)) + + ;; traverse the level, recursing on deeper levels: + (while (and (not at-end) + (> allout-recent-depth from-depth) + (setq this-widget (allout-get-item-widget))) + (if (< level-depth allout-recent-depth) + ;; recurse: + (progn + (setq subgot (allout-chart-exposure-contour-by-icon level-depth) + at-end (car subgot) + subgot (cdr subgot)) + (if subgot (setq got (append subgot got)))) + ;; progress at this level: + (when (memq (widget-get this-widget :icon-state) '(closed empty)) + (push (point) got) + (allout-end-of-subtree)) + (setq at-end (not (allout-next-heading))))) + + ;; tailor result depending on whether or not we're a recursion: + (if (not start-point) + (cons at-end got) + (goto-char start-point) + got))) +;;;_ > allout-range-overlaps (from to ranges) +(defun allout-range-overlaps (from to ranges) + "Return a pair indicating overlap of FROM and TO subtree range in RANGES. + +First element of result indicates whether candadate range FROM, TO +overlapped any of the existing ranges. + +Second element of result is a new version of RANGES incorporating the +candidate range with overlaps consolidated. + +FROM and TO must be in increasing order, as must be the pairs in RANGES." + ;; to append to the end: (rplacd next-to-last-cdr (list 'f)) + (let (new-ranges + entry + ;; the start of the range that includes the candidate from: + included-from + ;; the end of the range that includes the candidate to: + included-to + ;; the candidates were inserted: + done) + (while (and ranges (not done)) + (setq entry (car ranges) + ranges (cdr ranges)) + + (cond + + (included-from + ;; some entry included the candidate from. + (cond ((> (car entry) to) + ;; current entry exceeds end of candidate range - done. + (push (list included-from to) new-ranges) + (push entry new-ranges) + (setq included-to to + done t)) + ((>= (cadr entry) to) + ;; current entry includes end of candidate range - done. + (push (list included-from (cadr entry)) new-ranges) + (setq included-to (cadr entry) + done t)) + ;; current entry contained in candidate range - ditch, continue: + (t nil))) + + ((> (car entry) to) + ;; current entry start exceeds candidate end - done, placed as new entry + (push (list from to) new-ranges) + (push entry new-ranges) + (setq included-to to + done t)) + + ((>= (car entry) from) + ;; current entry start is above candidate start, but not above + ;; candidate end (by prior case). + (setq included-from from) + ;; now we have to check on whether this entry contains to, or continue: + (when (>= (cadr entry) to) + ;; current entry contains only candidate end - done: + (push (list included-from (cadr entry)) new-ranges) + (setq included-to (cadr entry) + done t)) + ;; otherwise, we will continue to look for placement of candidate end. + ) + + ((>= (cadr entry) to) + ;; current entry properly contains candidate range. + (push entry new-ranges) + (setq included-from (car entry) + included-to (cadr entry) + done t)) + + ((>= (cadr entry) from) + ;; current entry contains start of candidate range. + (setq included-from (car entry))) + + (t + ;; current entry is below the candidate range. + (push entry new-ranges)))) + + (cond ((and included-from included-to) + ;; candidates placed. + nil) + ((not (or included-from included-to)) + ;; candidates found no place, must be at the end: + (push (list from to) new-ranges)) + (included-from + ;; candidate start placed but end not: + (push (list included-from to) new-ranges)) + ;; might be included-to and not included-from, indicating new entry. + ) + (setq new-ranges (nreverse new-ranges)) + (if ranges (setq new-ranges (append new-ranges ranges))) + (list (if included-from t) new-ranges))) +;;;_ > allout-test-range-overlaps () +(defun allout-test-range-overlaps () + "allout-range-overlaps unit tests." + (let* (ranges + got + (try (lambda (from to) + (setq got (allout-range-overlaps from to ranges)) + (setq ranges (cadr got)) + got))) +;; ;; biggie: +;; (setq ranges nil) +;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall +;; ;; ~ 13 seconds for doing repeated funcall +;; (message "time-trial: %s, resulting size %s" +;; (time-trial +;; '(let ((size 10000) +;; doing) +;; (random t) +;; (dotimes (count size) +;; (setq doing (random size)) +;; (funcall try doing (+ doing (random 5))) +;; ;;(list doing (+ doing (random 5))) +;; ))) +;; (length ranges)) +;; (sit-for 2) + + ;; fresh: + (setq ranges nil) + (assert (equal (funcall try 3 5) '(nil ((3 5))))) + ;; add range at end: + (assert (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) + ;; add range at beginning: + (assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) + ;; insert range somewhere in the middle: + (assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) + ;; consolidate some: + (assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) + ;; add more: + (assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) + ;; add more: + (assert (equal (funcall try 20 22) + '(nil ((1 2) (3 9) (10 12) (15 17) (20 22))))) + ;; encompass more: + (assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) + ;; encompass all: + (assert (equal (funcall try 2 25) '(t ((1 25))))) + + ;; fresh slate: + (setq ranges nil) + (assert (equal (funcall try 20 25) '(nil ((20 25))))) + (assert (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) + (assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) + (assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) + (assert (equal (funcall try 10 30) '(t ((10 35))))) + (assert (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) + (assert (equal (funcall try 2 100) '(t ((2 100))))) + + (setq ranges nil) + )) +;;;_ > allout-widgetize-buffer (&optional doing) +(defun allout-widgetize-buffer (&optional doing) + "EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree. + +We economize by just focusing on the first of local-maximum depth siblings. + +Optional DOING is for internal use - a chart of the current level, for +recursive operation." + + (interactive) + (if (not doing) + + (save-excursion + (goto-char (point-min)) + ;; Construct the chart by scanning the siblings: + (dolist (top-level-sibling (allout-chart-siblings)) + (goto-char top-level-sibling) + (let ((subchart (allout-chart-subtree))) + (if subchart + (allout-widgetize-buffer subchart))))) + + ;; save-excursion was done on recursion entry, not necessary here. + (let (have-sublists) + (dolist (sibling doing) + (when (listp sibling) + (setq have-sublists t) + (allout-widgetize-buffer sibling))) + (when (and (not have-sublists) (not (widget-at (car doing)))) + (goto-char (car doing)) + (allout-get-or-create-item-widget))))) + +;;;_ : Item widget and constructors + +;;;_ $ allout-item-widget +(define-widget 'allout-item-widget 'default + "A widget presenting an allout outline item." + + 'button nil + ;; widget-field-at respects this to get item if 'field is unused. + ;; we don't use field to avoid collision with end-of-line, etc, on which + ;; allout depends. + 'real-field nil + + ;; data fields: + + + ;; tailor the widget for a specific item + :create 'allout-decorate-item-and-context + :value-delete 'allout-widgets-undecorate-item + ;; Not Yet Converted (from original, tree-widget stab) + :expander 'allout-tree-event-dispatcher ; get children when nil :args + :expander-p 'identity ; always engage the :expander + :action 'allout-tree-widget-action + ;; :notify "when item changes" + + ;; force decoration of item but not context, unless already done this tick: + :redecorate 'allout-redecorate-item + :last-decorated-tick nil + ;; recognize the actual situation of the item's text: + :parse-item 'allout-parse-item-at-point + ;; decorate the entirety of the item, sans offspring: + :decorate-item-span 'allout-decorate-item-span + ;; decorate the various item elements: + :decorate-guides 'allout-decorate-item-guides + :decorate-icon 'allout-decorate-item-icon + :decorate-cue 'allout-decorate-item-cue + :decorate-body 'allout-decorate-item-body + :actual-position 'allout-item-actual-position + + ;; Layout parameters: + :is-container nil ; is this actually the encompassing file/connection? + + :from nil ; item beginning - marker + :to nil ; item end - marker + :span-overlay nil ; overlay by which actual postion is determined + + ;; also serves as guide-end: + :icon-start nil + :icon-end nil + :distinctive-start nil + ;; also serves as cue-start: + :distinctive-end nil + ;; also serves as cue-end: + :body-start nil + :body-end nil + :depth nil + :has-subitems nil + :was-has-subitems 'init + :expanded nil + :was-expanded 'init + :brief nil + :was-brief 'init + + :does-encrypt nil ; pending encryption when :is-encrypted false. + :is-encrypted nil + + ;; the actual location of the item text: + :location 'allout-item-location + + :button-keymap allout-item-icon-keymap ; XEmacs + :keymap allout-item-icon-keymap ; Emacs + + ;; Element regions: + :guides-span nil + :icon-span nil + :cue-span nil + :bullet nil + :was-bullet nil + :body-span nil + + :body-brevity-p 'allout-body-brevity-p + + ;; :guide-column-flags indicate (in reverse order) whether or not the + ;; item's ancestor at the depth corresponding to the column has a + ;; subsequent sibling - ie, whether or not the corresponding column needs + ;; a descender line to connect that ancestor with its sibling. + :guide-column-flags nil + :was-guide-column-flags 'init + + ;; ie, has subitems: + :populous-p 'allout-item-populous-p + :help-echo 'allout-tree-widget-help-echo + ) +;;;_ > allout-new-item-widget () +(defsubst allout-new-item-widget () + "create a new item widget, not yet situated anywhere." + (if allout-widgets-maintain-tally + ;; all the extra overhead is incurred only when doing the + ;; maintenance, except the condition, which can't be avoided. + (let ((widget (widget-convert 'allout-item-widget))) + (puthash widget nil allout-widgets-tally) + widget) + (widget-convert 'allout-item-widget))) +;;;_ : Item decoration +;;;_ > allout-decorate-item-and-context (item-widget &optional redecorate +;;; blank-container parent) +(defun allout-decorate-item-and-context (item-widget &optional redecorate + blank-container parent) + "Create or adjust widget decorations for ITEM-WIDGET and neighbors at point. + +The neighbors include its siblings and parent. + +ITEM-WIDGET can be a created or converted allout-item-widget. + +If you're only trying to get or create a widget for an item, use +`allout-get-or-create-item-widget'. If you have the item-widget, applying +:redecorate will do the right thing. + +Optional BLANK-CONTAINER is for internal use. It is used to fabricate a +container widget for an empty-bodied container, in the course of decorating +a proper \(non-container\) item which starts at the beginning of the file. + +Optional REDECORATE causes redecoration of the item-widget and +its siblings, even if already decorated in this cycle of the command loop. + +Optional PARENT, when provided, bypasses some navigation and computation +necessary to obtain the parent of the items being processed. + +We return the item-widget corresponding to the item at point." + + (when (or redecorate + (not (equal (widget-get item-widget :last-decorated-tick) + allout-command-counter))) + (let* ((allout-inhibit-body-modification-hook t) + (was-modified (buffer-modified-p)) + (was-point (point)) + prefix-start + (is-container (or blank-container + (not (setq prefix-start (allout-goto-prefix))) + (< was-point prefix-start))) + ;; steady-point (set in two steps) is reliable across parent + ;; widget-creation. + (steady-point (progn (if is-container (goto-char 1)) + (point-marker))) + (steady-point (progn (set-marker-insertion-type steady-point t) + steady-point)) + (parent (and (not is-container) + (allout-get-or-create-parent-widget))) + parent-flags parent-depth + successor-sibling + body + doing-item + sub-item-widget + depth + reverse-siblings-chart + (buffer-undo-list t)) + + ;; At this point the parent is decorated and parent-flags indicate + ;; its guide lines. We will iterate over the siblings according to a + ;; chart we create at the start, and going from last to first so we + ;; don't have to worry about text displacement caused by widgetizing. + + (if is-container + (progn (widget-put item-widget :is-container t) + (setq reverse-siblings-chart (list 1))) + (goto-char (widget-apply parent :actual-position :from)) + (if (widget-get parent :is-container) + ;; `allout-goto-prefix' will go to first non-container item: + (allout-goto-prefix) + (allout-next-heading)) + (setq depth (allout-recent-depth)) + (setq reverse-siblings-chart (list allout-recent-prefix-beginning)) + (while (allout-next-sibling) + (push allout-recent-prefix-beginning reverse-siblings-chart))) + + (dolist (doing-at reverse-siblings-chart) + (goto-char doing-at) + (when allout-widgets-track-decoration + (sit-for 0)) + + (setq doing-item (if (= doing-at steady-point) + item-widget + (or (allout-get-item-widget) + (allout-new-item-widget)))) + + (when (or redecorate (not (equal (widget-get doing-item + :last-decorated-tick) + allout-command-counter))) + (widget-apply doing-item :parse-item t blank-container) + (widget-apply doing-item :decorate-item-span) + + (widget-apply doing-item :decorate-guides + parent (and successor-sibling t)) + (widget-apply doing-item :decorate-icon) + (widget-apply doing-item :decorate-cue) + (widget-apply doing-item :decorate-body) + + (widget-put doing-item :last-decorated-tick allout-command-counter)) + + (setq successor-sibling doing-at)) + + (set-buffer-modified-p was-modified) + (goto-char steady-point) + ;; must null the marker or the buffer gets clogged with impedence: + (set-marker steady-point nil) + + item-widget))) +;;;_ > allout-redecorate-item (item) +(defun allout-redecorate-item (item-widget) + "Resituate ITEM-WIDGET decorations, disregarding context. + +Use this to redecorate only the item, when you know that it's +situation with respect to siblings, parent, and offspring is +unchanged from its last decoration. Use +`allout-decorate-item-and-context' instead to reassess and adjust +relevent context, when suitable." + (if (not (equal (widget-get item-widget :last-decorated-tick) + allout-command-counter)) + (let ((was-modified (buffer-modified-p)) + (buffer-undo-list t)) + (widget-apply item-widget :parse-item) + (widget-apply item-widget :decorate-guides) + (widget-apply item-widget :decorate-icon) + (widget-apply item-widget :decorate-cue) + (widget-apply item-widget :decorate-body) + (set-buffer-modified-p was-modified)))) +;;;_ > allout-redecorate-visible-subtree (&optional parent-widget +;;; depth chart) +(defun allout-redecorate-visible-subtree (&optional parent-widget depth chart) + "Redecorate all visible items in subtree at point. + +Optional PARENT-WIDGET is for optimization, when the parent +widget is already available. + +Optional DEPTH restricts the excursion depth of covered. + +Optional CHART is for internal recursion, to carry a chart of the +target items. + +Point is left at the last sibling in the visible subtree." + ;; using a treatment that takes care of all the siblings on a level, we + ;; only need apply it to the first sibling on the level, and we can + ;; collect and pass the parent of the lower levels to recursive calls as + ;; we go. + (let ((parent-widget + (if (and parent-widget (widget-apply parent-widget + :actual-position :from)) + (progn (goto-char (widget-apply parent-widget + :actual-position :from)) + parent-widget) + (let ((got (allout-get-item-widget))) + (if got + (allout-decorate-item-and-context got 'redecorate) + (allout-get-or-create-item-widget 'redecorate))))) + (pending-chart (or chart (allout-chart-subtree nil 'visible))) + item-widget + previous-sibling-point + previous-sibling + recent-sibling-point) + (setq pending-chart (nreverse pending-chart)) + (dolist (sibling-point pending-chart) + (cond ((integerp sibling-point) + (when (not previous-sibling-point) + (goto-char sibling-point) + (if (setq item-widget (allout-get-item-widget nil)) + (allout-decorate-item-and-context item-widget 'redecorate + nil parent-widget) + (allout-get-or-create-item-widget))) + (setq previous-sibling-point sibling-point + recent-sibling-point sibling-point)) + ((listp sibling-point) + (if (or (not depth) + (> depth 1)) + (allout-redecorate-visible-subtree + (if (not previous-sibling-point) + ;; containment discontinuity - sigh + parent-widget + (allout-get-or-create-item-widget 'redecorate)) + (if depth (1- depth)) + sibling-point))))) + (if (and recent-sibling-point (< (point) recent-sibling-point)) + (goto-char recent-sibling-point)))) +;;;_ > allout-parse-item-at-point (item-widget &optional at-beginning +;;; blank-container) +(defun allout-parse-item-at-point (item-widget &optional at-beginning + blank-container) + "Set widget ITEM-WIDGET layout parameters per item-at-point's actual layout. + +If optional AT-BEGINNING is t, then point is assumed to be at the start of +the item prefix. + +If optional BLANK-CONTAINER is true, then the parameters of a container +which has an empty body are set. \(Though the body is blank, the object +may have subitems.\)" + + ;; Uncomment this sit-for to notice where decoration is happening: +;; (sit-for .1) + (let* ((depth (allout-depth)) + (depth (if blank-container 0 depth)) + (is-container (or blank-container (zerop depth))) + + (does-encrypt (and (not is-container) + (allout-encrypted-type-prefix))) + (is-encrypted (and does-encrypt (allout-encrypted-topic-p))) + (icon-end allout-recent-prefix-end) + (icon-start (1- icon-end)) + body-start + body-end + bullet + has-subitems + (contents-depth (1+ depth)) + ) + (widget-put item-widget :depth depth) + (if is-container + + (progn + (widget-put item-widget :from (allout-set-boundary-marker + :from (point-min) + (widget-get item-widget :from))) + (widget-put item-widget :icon-end nil) + (widget-put item-widget :icon-start nil) + (setq body-start (widget-put item-widget :body-start 1))) + + ;; not container: + + (widget-put item-widget :from (allout-set-boundary-marker + :from (if at-beginning + (point) + allout-recent-prefix-beginning) + (widget-get item-widget :from))) + (widget-put item-widget :icon-start icon-start) + (widget-put item-widget :icon-end icon-end) + (when does-encrypt + (widget-put item-widget :does-encrypt t) + (widget-put item-widget :is-encrypted is-encrypted)) + + ;; cue area: + (setq body-start icon-end) + (widget-put item-widget :bullet (setq bullet (allout-get-bullet))) + (if (equal (char-after body-start) ? ) + (setq body-start (1+ body-start))) + (widget-put item-widget :body-start body-start) + ) + + ;; Both container and regular items: + + ;; :body-end (doesn't include a trailing blank line, if any) - + (widget-put item-widget :body-end (setq body-end + (if blank-container + 1 + (allout-end-of-entry)))) + + (widget-put item-widget :to (allout-set-boundary-marker + :to (if blank-container + (point-min) + (or (allout-pre-next-prefix) + (goto-char (point-max)))) + (widget-get item-widget :to))) + (widget-put item-widget :has-subitems + (setq has-subitems + (and + ;; has a subsequent item: + (not (= body-end (point-max))) + ;; subsequent item is deeper: + (< depth (setq contents-depth (allout-recent-depth)))))) + ;; note :expanded - true if widget item's content is currently visible? + (widget-put item-widget :expanded + (and has-subitems + ;; subsequent item is or isn't visible: + (save-excursion + (goto-char allout-recent-prefix-beginning) + (not (allout-hidden-p))))))) +;;;_ > allout-set-boundary-marker (boundary position &optional current-marker) +(defun allout-set-boundary-marker (boundary position &optional current-marker) + "Set or create item widget BOUNDARY type marker at POSITION. + +Optional CURRENT-MARKER is the marker currently being used for +the boundary, if any. + +BOUNDARY type is either :from or :to, determining the marker insertion type." + (if (not position) (setq position (point))) + (if current-marker + (set-marker current-marker position) + (let ((marker (make-marker))) + ;; XXX dang - would like for :from boundary to advance after inserted + ;; text, but that would omit new header prefixes when allout + ;; relevels, etc. this competes with ad-hoc edits, which would + ;; better be omitted + (set-marker-insertion-type marker nil) + (set-marker marker position)))) +;;;_ > allout-decorate-item-span (item-widget) +(defun allout-decorate-item-span (item-widget) + "Equip the item with a span, as an entirety. + +This span is implemented so it can be used to detect displacement +of the widget in absolute terms, and provides an offset bias for +the various element spans." + + (if (and (widget-get item-widget :is-container) + ;; the only case where the span could be empty. + (eq (widget-get item-widget :from) + (widget-get item-widget :to))) + nil + (allout-item-span item-widget + (widget-get item-widget :from) + (widget-get item-widget :to)))) +;;;_ > allout-decorate-item-guides (item-widget +;;; &optional parent-widget has-successor) +(defun allout-decorate-item-guides (item-widget + &optional parent-widget has-successor) + "Add ITEM-WIDGET guide icon-prefix descender and connector text properties. + +Optional arguments provide context for deriving the guides. In +their absence, the current guide column flags are used. + +Optional PARENT-WIDGET is the widget for the item's parent item. + +Optional HAS-SUCCESSOR is true iff the item is followed by a sibling. + +We also hide the header-prefix string. + +Guides are established according to the item-widget's :guide-column-flags, +when different than :was-guide-column-flags. Changing that property and +reapplying this method will rectify the glyphs." + + (when (not (widget-get item-widget :is-container)) + (let* ((depth (widget-get item-widget :depth)) + (parent-depth (and parent-widget + (widget-get parent-widget :depth))) + (parent-flags (and parent-widget + (widget-get parent-widget :guide-column-flags))) + (parent-flags-depth (length parent-flags)) + (extender-length (- depth (+ parent-flags-depth 2))) + (flags (or (and (> depth 1) + parent-widget + (widget-put item-widget :guide-column-flags + (append (list has-successor) + (if (< 0 extender-length) + (make-list extender-length + '-)) + parent-flags))) + (widget-get item-widget :guide-column-flags))) + (was-flags (widget-get item-widget :was-guide-column-flags)) + (guides-start (widget-get item-widget :from)) + (guides-end (widget-get item-widget :icon-start)) + (position guides-start) + (increment (length allout-header-prefix)) + reverse-flags + guide-name + extenders paint-extenders + (inhibit-read-only t)) + + (when (not (equal was-flags flags)) + + (setq reverse-flags (reverse flags)) + (while reverse-flags + (setq guide-name + (cond ((null (cdr reverse-flags)) + (if (car reverse-flags) + 'mid-connector + 'end-connector)) + ((eq (car reverse-flags) '-) + ;; accumulate extenders tally, to be painted on next + ;; non-extender flag, according to the flag type. + (setq extenders (1+ (or extenders 0))) + nil) + ((car reverse-flags) + 'through-descender) + (t 'skip-descender))) + (when guide-name + (put-text-property position (setq position (+ position increment)) + 'display (allout-fetch-icon-image guide-name)) + (if (> increment 1) (setq increment 1)) + (when extenders + ;; paint extenders after a connector, else leave spaces. + (dotimes (i extenders) + (put-text-property + position (setq position (1+ position)) + 'display (allout-fetch-icon-image + (if (memq guide-name '(mid-connector end-connector)) + 'extender-connector + 'skip-descender)))) + (setq extenders nil))) + (setq reverse-flags (cdr reverse-flags))) + (widget-put item-widget :was-guide-column-flags flags)) + + (allout-item-element-span-is item-widget :guides-span + guides-start guides-end)))) +;;;_ > allout-decorate-item-icon (item-widget) +(defun allout-decorate-item-icon (item-widget) + "Add item icon glyph and distinctive bullet text properties to ITEM-WIDGET." + + (when (not (widget-get item-widget :is-container)) + (let* ((icon-start (widget-get item-widget :icon-start)) + (icon-end (widget-get item-widget :icon-end)) + (bullet (widget-get item-widget :bullet)) + (use-bullet bullet) + (was-bullet (widget-get item-widget :was-bullet)) + (distinctive (allout-distinctive-bullet bullet)) + (distinctive-start (widget-get item-widget :distinctive-start)) + (distinctive-end (widget-get item-widget :distinctive-end)) + (does-encrypt (widget-get item-widget :does-encrypt)) + (is-encrypted (and does-encrypt (widget-get item-widget + :is-encrypted))) + (expanded (widget-get item-widget :expanded)) + (has-subitems (widget-get item-widget :has-subitems)) + (inhibit-read-only t) + icon-state) + + (when (not (and (equal (widget-get item-widget :was-expanded) expanded) + (equal (widget-get item-widget :was-has-subitems) + has-subitems) + (equal (widget-get item-widget :was-does-encrypt) + does-encrypt) + (equal (widget-get item-widget :was-is-encrypted) + is-encrypted))) + + (setq icon-state + (cond (does-encrypt (if is-encrypted + 'encrypted-locked + 'encrypted-unlocked)) + (expanded 'opened) + (has-subitems 'closed) + (t 'empty))) + (put-text-property icon-start (1+ icon-start) + 'display (allout-fetch-icon-image icon-state)) + (widget-put item-widget :was-expanded expanded) + (widget-put item-widget :was-has-subitems has-subitems) + (widget-put item-widget :was-does-encrypt does-encrypt) + (widget-put item-widget :was-is-encrypted is-encrypted) + ;; preserve as a widget property to track last known: + (widget-put item-widget :icon-state icon-state) + ;; preserve as a text property to track undo: + (put-text-property icon-start icon-end :icon-state icon-state)) + (allout-item-element-span-is item-widget :icon-span + icon-start icon-end) + (when (not (string= was-bullet bullet)) + (cond ((not distinctive) + ;; XXX we strip the prior properties without even checking if + ;; the prior bullet was distinctive, because the widget + ;; provisions to convey that info is disappearing, sigh. + (remove-text-properties icon-end (1+ icon-end) '(display)) + (setq distinctive-start icon-end distinctive-end icon-end) + (widget-put item-widget :distinctive-start distinctive-start) + (widget-put item-widget :distinctive-end distinctive-end)) + + ((not (string= bullet allout-numbered-bullet)) + (setq distinctive-start icon-end distinctive-end (+ icon-end 1))) + + (does-encrypt + (setq distinctive-start icon-end distinctive-end (+ icon-end 1))) + + (t + (goto-char icon-end) + (looking-at "[0-9]+") + (setq use-bullet (buffer-substring icon-end (match-end 0))) + (setq distinctive-start icon-end + distinctive-end (match-end 0)))) + (put-text-property distinctive-start distinctive-end 'display + use-bullet) + (widget-put item-widget :was-bullet bullet) + (widget-put item-widget :distinctive-start distinctive-start) + (widget-put item-widget :distinctive-end distinctive-end))))) +;;;_ > allout-decorate-item-cue (item-widget) +(defun allout-decorate-item-cue (item-widget) + "Incorporate space between bullet icon and body to the ITEM-WIDGET." + ;; NOTE: most of the cue-area + + (when (not (widget-get item-widget :is-container)) + (let* ((cue-start (or (widget-get item-widget :distinctive-end) + (widget-get item-widget :icon-end))) + (body-start (widget-get item-widget :body-start)) + (expanded (widget-get item-widget :expanded)) + (has-subitems (widget-get item-widget :has-subitems)) + (inhibit-read-only t)) + + (allout-item-element-span-is item-widget :cue-span cue-start body-start) + (put-text-property (1- body-start) body-start 'rear-nonsticky t)))) +;;;_ > allout-decorate-item-body (item-widget &optional force) +(defun allout-decorate-item-body (item-widget &optional force) + "Incorporate item body text as part the ITEM-WIDGET. + +Optional FORCE means force reassignment of the region property." + + (let* ((allout-inhibit-body-modification-hook t) + (body-start (widget-get item-widget :body-start)) + (body-end (widget-get item-widget :body-end)) + (body-text-end body-end) + (inhibit-read-only t)) + + (allout-item-element-span-is item-widget :body-span + body-start (min (1+ body-end) (point-max)) + force))) +;;;_ > allout-item-actual-position (item-widget field) +(defun allout-item-actual-position (item-widget field) + "Return ITEM-WIDGET FIELD position taking item displacement into account." + + ;; The item's sub-element positions (:icon-end, :body-start, etc) are + ;; accurate when the item is parsed, but some offsets from the start + ;; drift with text added in the body. + ;; + ;; Rather than reparse an item with every change (inefficient), or derive + ;; every position from a distinct field marker/overlay (prohibitive as + ;; the number of items grows), we use the displacement tracking of the + ;; :span-overlay's markers, against the registered :from or :body-end + ;; (depending on whether the requested field value is before or after the + ;; item body), to bias the registered values. + ;; + ;; This is not necessary/useful when the item is being decorated, because + ;; that always must be preceeded by a fresh item parse. + + (if (not (eq field :body-end)) + (widget-get item-widget :from) + + (let* ((span-overlay (widget-get item-widget :span-overlay)) + (body-end-position (widget-get item-widget :body-end)) + (ref-marker-position (and span-overlay + (overlay-end span-overlay))) + (offset (and body-end-position span-overlay + (- (or ref-marker-position 0) + body-end-position)))) + (+ (widget-get item-widget field) (or offset 0))))) +;;;_ : Item undecoration +;;;_ > allout-widgets-undecorate-region (start end) +(defun allout-widgets-undecorate-region (start end) + "Eliminate widgets and decorations for all items in region from START to END." + (let ((next start) + widget) + (save-excursion + (goto-char start) + (while (< (setq next (next-single-char-property-change next + 'display + (current-buffer) + end)) + end) + (goto-char next) + (when (setq widget (allout-get-item-widget)) + ;; if the next-property/overly progression got us to a widget: + (allout-widgets-undecorate-item widget t)))))) +;;;_ > allout-widgets-undecorate-text (text) +(defun allout-widgets-undecorate-text (text) + "Eliminate widgets and decorations for all items in TEXT." + (remove-text-properties 0 (length text) + '(display nil :icon-state nil rear-nonsticky nil + category nil button nil field nil) + text) + text) +;;;_ > allout-widgets-undecorate-item (item-widget &optional no-expose) +(defun allout-widgets-undecorate-item (item-widget &optional no-expose) + "Remove widget decorations from ITEM-WIDGET. + +Any concealed content head lines and item body is exposed, unless +optional NO-EXPOSE is non-nil." + (let ((from (widget-get item-widget :from)) + (to (widget-get item-widget :to)) + (text-properties-to-remove '(display nil + :icon-state nil + rear-nonsticky nil + category nil + button nil + field nil)) + (span-overlay (widget-get item-widget :span-overlay)) + (button-overlay (widget-get item-widget :button)) + (was-modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t)) + (if (not no-expose) + (allout-flag-region from to nil)) + (allout-unprotected + (remove-text-properties from to text-properties-to-remove)) + (when span-overlay + (delete-overlay span-overlay) (widget-put item-widget :span-overlay nil)) + (when button-overlay + (delete-overlay button-overlay) (widget-put item-widget :button nil)) + (set-marker from nil) + (set-marker to nil) + (if (not was-modified) + (set-buffer-modified-p nil)))) + +;;;_ : Item decoration support +;;;_ > allout-item-span (item-widget &optional start end) +(defun allout-item-span (item-widget &optional start end) + "Return or register the location of an ITEM-WIDGET's actual START and END. + +If START and END are not passed in, return either a dotted pair +of the current span, if established, or nil if not yet set. + +When the START and END are passed, return the distance that the +start of the item moved. We return 0 if the span was not +previously established or is not moved." + (let ((overlay (widget-get item-widget :span-overlay)) + was-start was-end + changed) + (cond ((not overlay) (when start + (setq overlay (make-overlay start end nil t nil)) + (overlay-put overlay 'button item-widget) + (widget-put item-widget :span-overlay overlay) + t)) + ;; report: + ((not start) (cons (overlay-start overlay) (overlay-end overlay))) + ;; move: + ((or (not (equal (overlay-start overlay) start)) + (not (equal (overlay-end overlay) end))) + (move-overlay overlay start end) + t) + ;; specified span already set: + (t nil)))) +;;;_ > allout-item-element-span-is (item-widget element +;;; &optional start end force) +(defun allout-item-element-span-is (item-widget element + &optional start end force) + "Return or register the location of the indicated ITEM-WIDGET ELEMENT. + +ELEMENT is one of :guides-span, :icon-span, :cue-span, or :body-span. + +When optional START is specified, optional END must also be. + +START and END are the actual bounds of the region, if provided. + +If START and END are not passed in, we return either a dotted +pair of the current span, if established, or nil if not yet set. + +When the START and END are passed, we return t if the region +changed or nil if not. + +Optional FORCE means force assignment of the region's text +property, even if it's already set." + (let ((span (widget-get item-widget element))) + (cond ((or (not span) force) + (when start + (widget-put item-widget element (cons start end)) + (put-text-property start end 'category + (cdr (assoc element + allout-span-to-category))) + t)) + ;; report: + ((not start) span) + ;; move if necessary: + ((not (and (eq (car span) start) + (eq (cdr span) end))) + (widget-put item-widget element span) + t) + ;; specified span already set: + (t nil)))) +;;;_ : Item widget retrieval (/ high-level creation): +;;;_ > allout-get-item-widget (&optional container) +(defun allout-get-item-widget (&optional container) + "Return the widget for the item at point, or nil if no widget yet exists. + +Point must be situated *before* the start of the target item's +body, so we don't get an existing containing item when we're in +the process of creating an item in the middle of another. + +Optional CONTAINER is used to obtain the container item." + (if (or container (zerop (allout-depth))) + allout-container-item-widget + ;; allout-recent-* are calibrated by (allout-depth) if we got here. + (let ((got (widget-at allout-recent-prefix-beginning))) + (if (and got (listp got)) + (if (marker-position (widget-get got :from)) + (and + (>= (point) (widget-apply got :actual-position :from)) + (<= (point) (widget-apply got :actual-position :body-start)) + got) + ;; a wacky residual item - undecorate and disregard: + (allout-widgets-undecorate-item got) + nil))))) +;;;_ > allout-get-or-create-item-widget (&optional redecorate blank-container) +(defun allout-get-or-create-item-widget (&optional redecorate blank-container) + "Return a widget for the item at point, creating the widget if necessary. + +When creating a widget, we assume there has been a context change +and decorate its siblings and parent, as well. + +Optional BLANK-CONTAINER is for internal use, to fabricate a +meta-container item with an empty body when the first proper +\(non-container\) item starts at the beginning of the file. + +Optional REDECORATE, if non-nil, means to redecorate the widget +if it already exists." + (let ((widget (allout-get-item-widget blank-container)) + (buffer-undo-list t)) + (cond (widget (if redecorate + (allout-redecorate-item widget)) + widget) + ((or blank-container (zerop (allout-depth))) + (or allout-container-item-widget + (setq allout-container-item-widget + (allout-decorate-item-and-context + (widget-convert 'allout-item-widget) + nil blank-container)))) + ;; create a widget for a regular/non-container item: + (t (allout-decorate-item-and-context (widget-convert + 'allout-item-widget)))))) +;;;_ > allout-get-or-create-parent-widget (&optional redecorate) +(defun allout-get-or-create-parent-widget (&optional redecorate) + "Return widget for parent of item at point, decorating it if necessary. + +We return the container widget if we're above the first proper item in the +file. + +Optional REDECORATE, if non-nil, means to redecorate the widget if it +already exists. + +Point will wind up positioned on the beginning of the parent or beginning +of the buffer." + ;; use existing widget, if there, else establish it + (if (or (bobp) (and (not (allout-ascend)) + (looking-at allout-regexp))) + (allout-get-or-create-item-widget redecorate 'blank-container) + (allout-get-or-create-item-widget redecorate))) +;;;_ : X- Item ancillaries +;;;_ >X allout-body-modification-handler (beg end) +(defun allout-body-modification-handler (beg end) + "Do routine processing of body text before and after modification. + +Operation is inhibited by `allout-inhibit-body-modification-handler'." + +;; The primary duties are: +;; +;; - marking of escaped prefix-like text for delayed cleanup of escapes +;; - removal and replacement of the settings +;; - maintenance of beginning-of-line guide lines +;; +;; ?? Escapes removal \(before changes\) is not done when edits span multiple +;; items, recognizing that item structure is being preserved, including +;; escaping of item-prefix-like text within bodies. See +;; `allout-before-modification-handler' and +;; `allout-inhibit-body-modification-handler'. +;; +;; Adds the overlay to the `allout-unresolved-body-mod-workhash' during +;; before-change operation, and removes from that list during after-change +;; operation. + (cond (allout-inhibit-body-modification-hook nil))) +;;;_ >X allout-graphics-modification-handler (beg end) +(defun allout-graphics-modification-handler (beg end) + "Protect against incoherent deletion of decoration graphics. + +Deletes allowed only when inhibit-read-only is t." + (cond + (undo-in-progress (when (eq (get-text-property beg 'category) + 'allout-icon-span-category) + (save-excursion + (goto-char beg) + (let* ((item-widget (allout-get-item-widget))) + (if item-widget + (allout-widgets-exposure-undo-recorder + item-widget)))))) + (inhibit-read-only t) + ((not (and (boundp 'allout-mode) allout-mode)) t) + ((equal this-command 'quoted-insert) t) + ((yes-or-no-p "Unruly edit of outline structure - allow? ") + (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only) + inhibit-read-only t)) + (t (error + (substitute-command-keys allout-structure-unruly-deletion-message))))) +;;;_ > allout-item-icon-key-handler () +(defun allout-item-icon-key-handler () + "Catchall handling of key bindings in item icon/cue hot-spots. + +Applies `allout-hotspot-key-handler' and calls the result, if any, as an +interactive command." + + (interactive) + (let* ((mapped-binding (allout-hotspot-key-handler))) + (when mapped-binding + (call-interactively mapped-binding)))) + +;;;_ : Status +;;;_ . allout-item-location (item-widget) +(defun allout-item-location (item-widget) + "Location of the start of the item's text." + (overlay-start (widget-get item-widget :span-overlay))) + +;;;_ : Icon management +;;;_ > allout-fetch-icon-image (name) +(defun allout-fetch-icon-image (name) + "Fetch allout icon for symbol NAME. + +We use a caching strategy, so the caller doesn't need to do so." + (let* ((types allout-widgets-icon-types) + (use-dir (if (equal (allout-frame-property nil 'background-mode) + 'light) + allout-widgets-icons-light-subdir + allout-widgets-icons-dark-subdir)) + (key (list name use-dir)) + (got (assoc key allout-widgets-icons-cache))) + (if got + ;; display system shows only first of subsequent adjacent + ;; `eq'-identical repeats - use copies to avoid this problem. + (allout-widgets-copy-list (cadr got)) + (while (and types (not got)) + (setq got + (allout-find-image + (list (append (list :type (car types) + :file (concat use-dir + (symbol-name name) + "." (symbol-name + (car types)))) + (if (featurep 'xemacs) + allout-widgets-item-image-properties-xemacs + allout-widgets-item-image-properties-emacs) + )))) + (setq types (cdr types))) + (if got + (push (list key got) allout-widgets-icons-cache)) + got))) + +;;;_ : Miscellaneous +;;;_ > allout-elapsed-time-seconds (triple) +(defun allout-elapsed-time-seconds (end start) + "Return seconds between `current-time' style time START/END triples." + (let ((elapsed (time-subtract end start))) + (+ (* (car elapsed) (expt 2.0 16)) + (cadr elapsed) + (/ (caddr elapsed) (expt 10.0 6))))) +;;;_ > allout-frame-property (frame property) +(defalias 'allout-frame-property + (cond ((fboundp 'frame-parameter) + 'frame-parameter) + ((fboundp 'frame-property) + 'frame-property) + (t nil))) +;;;_ > allout-find-image (specs) +(defalias 'allout-find-image + (if (fboundp 'find-image) + 'find-image + nil) ; aka, not-yet-implemented for xemacs. +) +;;;_ > allout-widgets-copy-list (list) +(defun allout-widgets-copy-list (list) + ;; duplicated from cl.el 'copy-list' as of 2008-08-17 + "Return a copy of LIST, which may be a dotted list. +The elements of LIST are not copied, just the list structure itself." + (if (consp list) + (let ((res nil)) + (while (consp list) (push (pop list) res)) + (prog1 (nreverse res) (setcdr res list))) + (car list))) + +;;;_ : Run unit tests: +(defun allout-widgets-run-unit-tests () + (message "Running allout-widget tests...") + + (allout-test-range-overlaps) + + (message "Running allout-widget tests... Done.") + (sit-for .5)) + +(when allout-widgets-run-unit-tests-on-load + (allout-widgets-run-unit-tests)) + +;;;_ : provide +(provide 'allout-widgets) + +;;;_. Local emacs vars. +;;;_ , Local variables: +;;;_ , allout-layout: (-1 : 0) +;;;_ , End: ------------------------------------------------------------ revno: 103304 committer: Ken Manheimer branch nick: trunk timestamp: Wed 2011-02-16 16:29:32 -0500 message: Include PGP and GnuPG in Keywords, and other commentary refinements. (allout-abbreviate-flattened-numbering): Rename to allout-flattened-numbering-abbreviation, and define-obsolete-variable-alias the old name. (allout-flattened-numbering-abbreviation): Rename from allout-abbreviate-flattened-numbering. (allout-mode-p): Include among autoloads, for use by other modes with impunity. (allout-listify-exposed): Use allout-flattened-numbering-abbreviation. (allout-encrypt-string): Use set-buffer-multibyte directly. (allout-set-buffer-multibyte): Remove. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 21:06:23 +0000 +++ lisp/ChangeLog 2011-02-16 21:29:32 +0000 @@ -1,3 +1,19 @@ +2011-02-16 Ken Manheimer + + * allout.el: Include PGP and GnuPG in Keywords, and other + commentary refinements. + (allout-abbreviate-flattened-numbering): Rename to + allout-flattened-numbering-abbreviation, and + define-obsolete-variable-alias the old name. + (allout-flattened-numbering-abbreviation): Rename from + allout-abbreviate-flattened-numbering. + (allout-mode-p): Include among autoloads, for use by other modes + with impunity. + (allout-listify-exposed): Use + allout-flattened-numbering-abbreviation. + (allout-encrypt-string): Use set-buffer-multibyte directly. + (allout-set-buffer-multibyte): Remove. + 2011-02-16 Deniz Dogan * simple.el (just-one-space): Remove useless `or' call. === modified file 'lisp/allout.el' --- lisp/allout.el 2011-02-10 00:31:18 +0000 +++ lisp/allout.el 2011-02-16 21:29:32 +0000 @@ -6,7 +6,7 @@ ;; Maintainer: Ken Manheimer ;; Created: Dec 1991 -- first release to usenet ;; Version: 2.3 -;; Keywords: outlines wp languages +;; Keywords: outlines, wp, languages, PGP, GnuPG ;; Website: http://myriadicity.net/Sundry/EmacsAllout ;; This file is part of GNU Emacs. @@ -59,8 +59,8 @@ ;; See the `allout-mode' function's docstring for an introduction to the ;; mode. ;; -;; The latest development version and helpful notes are available at -;; http://myriadicity.net/Sundry/EmacsAllout . +;; Directions to the latest development version and helpful notes are +;; available at http://myriadicity.net/Sundry/EmacsAllout . ;; ;; The outline menubar additions provide quick reference to many of the ;; features. See the docstring of the variables `allout-layout' and @@ -76,7 +76,7 @@ ;;; Code: -;;;_* Dependency autoloads +;;;_* Dependency loads (require 'overlay) (eval-when-compile ;; Most of the requires here are for stuff covered by autoloads, which @@ -94,7 +94,9 @@ ;;;_ > defgroup allout, allout-keybindings (defgroup allout nil - "Extensive outline mode for use alone and with other modes." + "Extensive outline minor-mode, for use stand-alone and with other modes. + +See Allout Auto Activation for automatic activation." :prefix "allout-" :group 'outlines) (defgroup allout-keybindings nil @@ -308,9 +310,7 @@ With value \"activate\", only auto-mode-activation is enabled. Auto-layout is not. -With value nil, neither auto-mode-activation nor auto-layout are -enabled, and allout auto-activation processing is removed from -file visiting activities." +With value nil, inhibit any automatic allout-mode activation." :set 'allout-auto-activation-helper :type '(choice (const :tag "On" t) (const :tag "Ask about layout" "ask") @@ -752,8 +752,10 @@ ;;;###autoload (put 'allout-presentation-padding 'safe-local-variable 'integerp) -;;;_ = allout-abbreviate-flattened-numbering -(defcustom allout-abbreviate-flattened-numbering nil +;;;_ = allout-flattened-numbering-abbreviation +(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering + 'allout-flattened-numbering-abbreviation "24.0") +(defcustom allout-flattened-numbering-abbreviation nil "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic numbers to minimal amount with some context. Otherwise, entire numbers are always used." @@ -1553,6 +1555,7 @@ ;;;_ > allout-mode-p () ;; Must define this macro above any uses, or byte compilation will lack ;; proper def, if file isn't loaded -- eg, during emacs build! +;;;###autoload (defmacro allout-mode-p () "Return t if `allout-mode' is active in current buffer." 'allout-mode) @@ -5410,7 +5413,7 @@ bullet))) (cond ((listp format) (list depth - (if allout-abbreviate-flattened-numbering + (if allout-flattened-numbering-abbreviation (allout-stringify-flat-index format gone-out) (allout-stringify-flat-index-plain @@ -6054,7 +6057,7 @@ (with-temp-buffer (insert text) ;; convey the text characteristics of the original buffer: - (allout-set-buffer-multibyte multibyte) + (set-buffer-multibyte multibyte) (when encoding (set-buffer-file-coding-system encoding) (if (not decrypt) @@ -6673,14 +6676,6 @@ 'previous-single-property-change) ;; No docstring because xemacs defalias doesn't support it. ) -;;;_ > allout-set-buffer-multibyte -(if (fboundp 'set-buffer-multibyte) - (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) - (with-no-warnings - ;; this definition is used only in older or alternative emacs, where - ;; the setting is our only recourse. - (defun allout-set-buffer-multibyte (is-multibyte) - (set enable-multibyte-characters is-multibyte)))) ;;;_ > allout-select-safe-coding-system (defalias 'allout-select-safe-coding-system (if (fboundp 'select-safe-coding-system) ------------------------------------------------------------ revno: 103303 committer: Deniz Dogan branch nick: emacs-trunk timestamp: Wed 2011-02-16 22:06:23 +0100 message: * lisp/simple.el (just-one-space): Remove useless `or' call. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 19:56:31 +0000 +++ lisp/ChangeLog 2011-02-16 21:06:23 +0000 @@ -1,3 +1,7 @@ +2011-02-16 Deniz Dogan + + * simple.el (just-one-space): Remove useless `or' call. + 2011-02-16 Alex Harsanyi * soap-client.el (soap-well-known-xmlns, soap-local-xmlns) === modified file 'lisp/simple.el' --- lisp/simple.el 2011-02-12 23:40:43 +0000 +++ lisp/simple.el 2011-02-16 21:06:23 +0000 @@ -778,7 +778,7 @@ (n (abs n))) (skip-chars-backward skip-characters) (constrain-to-field nil orig-pos) - (dotimes (i (or n 1)) + (dotimes (i n) (if (= (following-char) ?\s) (forward-char 1) (insert ?\s))) ------------------------------------------------------------ revno: 103302 committer: Michael Albinus branch nick: trunk timestamp: Wed 2011-02-16 20:56:31 +0100 message: * soap-client.el (soap-well-known-xmlns, soap-local-xmlns) (soap-default-xmlns, soap-target-xmlns, soap-multi-refs) (soap-decoded-multi-refs, soap-current-wsdl) (soap-encoded-namespaces): Rename CL-style *...* variables. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 19:33:35 +0000 +++ lisp/ChangeLog 2011-02-16 19:56:31 +0000 @@ -1,3 +1,10 @@ +2011-02-16 Alex Harsanyi + + * soap-client.el (soap-well-known-xmlns, soap-local-xmlns) + (soap-default-xmlns, soap-target-xmlns, soap-multi-refs) + (soap-decoded-multi-refs, soap-current-wsdl) + (soap-encoded-namespaces): Rename CL-style *...* variables. + 2011-02-16 Michael Albinus * net/soap-client.el: Add "comm" and "hypermedia" to the === modified file 'lisp/net/soap-client.el' --- lisp/net/soap-client.el 2011-02-16 19:33:35 +0000 +++ lisp/net/soap-client.el 2011-02-16 19:56:31 +0000 @@ -63,7 +63,7 @@ ;; "well known" namespace tag and the local namespace tag in the document ;; being parsed. -(defconst *soap-well-known-xmlns* +(defconst soap-well-known-xmlns '(("apachesoap" . "http://xml.apache.org/xml-soap") ("soapenc" . "http://schemas.xmlsoap.org/soap/encoding/") ("wsdl" . "http://schemas.xmlsoap.org/wsdl/") @@ -76,18 +76,18 @@ ("mime" . "http://schemas.xmlsoap.org/wsdl/mime/")) "A list of well known xml namespaces and their aliases.") -(defvar *soap-local-xmlns* nil +(defvar soap-local-xmlns nil "A list of local namespace aliases. This is a dynamically bound variable, controlled by `soap-with-local-xmlns'.") -(defvar *soap-default-xmlns* nil +(defvar soap-default-xmlns nil "The default XML namespaces. Names in this namespace will be unqualified. This is a dynamically bound variable, controlled by `soap-with-local-xmlns'") -(defvar *soap-target-xmlns* nil +(defvar soap-target-xmlns nil "The target XML namespace. New XSD elements will be defined in this namespace, unless they are fully qualified for a different namespace. This is a @@ -97,9 +97,9 @@ (defun soap-wk2l (well-known-name) "Return local variant of WELL-KNOWN-NAME. This is done by looking up the namespace in the -`*soap-well-known-xmlns*' table and resolving the namespace to +`soap-well-known-xmlns' table and resolving the namespace to the local name based on the current local translation table -`*soap-local-xmlns*'. See also `soap-with-local-xmlns'." +`soap-local-xmlns'. See also `soap-with-local-xmlns'." (let ((wk-name-1 (if (symbolp well-known-name) (symbol-name well-known-name) well-known-name))) @@ -107,14 +107,14 @@ ((string-match "^\\(.*\\):\\(.*\\)$" wk-name-1) (let ((ns (match-string 1 wk-name-1)) (name (match-string 2 wk-name-1))) - (let ((namespace (cdr (assoc ns *soap-well-known-xmlns*)))) - (cond ((equal namespace *soap-default-xmlns*) + (let ((namespace (cdr (assoc ns soap-well-known-xmlns)))) + (cond ((equal namespace soap-default-xmlns) ;; Name is unqualified in the default namespace (if (symbolp well-known-name) (intern name) name)) (t - (let* ((local-ns (car (rassoc namespace *soap-local-xmlns*))) + (let* ((local-ns (car (rassoc namespace soap-local-xmlns))) (local-name (concat local-ns ":" name))) (if (symbolp well-known-name) (intern local-name) @@ -124,7 +124,7 @@ (defun soap-l2wk (local-name) "Convert LOCAL-NAME into a well known name. The namespace of LOCAL-NAME is looked up in the -`*soap-well-known-xmlns*' table and a well known namespace tag is +`soap-well-known-xmlns' table and a well known namespace tag is used in the name. nil is returned if there is no well-known namespace for the @@ -137,15 +137,15 @@ ((string-match "^\\(.*\\):\\(.*\\)$" l-name-1) (setq name (match-string 2 l-name-1)) (let ((ns (match-string 1 l-name-1))) - (setq namespace (cdr (assoc ns *soap-local-xmlns*))) + (setq namespace (cdr (assoc ns soap-local-xmlns))) (unless namespace (error "Soap-l2wk(%s): no namespace for alias %s" local-name ns)))) (t (setq name l-name-1) - (setq namespace *soap-default-xmlns*))) + (setq namespace soap-default-xmlns))) (if namespace - (let ((well-known-ns (car (rassoc namespace *soap-well-known-xmlns*)))) + (let ((well-known-ns (car (rassoc namespace soap-well-known-xmlns)))) (if well-known-ns (let ((well-known-name (concat well-known-ns ":" name))) (if (symbol-name local-name) @@ -166,9 +166,9 @@ converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\"\). The USE-TNS argument specifies what to do when LOCAL-NAME has no -namespace tag. If USE-TNS is non-nil, the `*soap-target-xmlns*' +namespace tag. If USE-TNS is non-nil, the `soap-target-xmlns' will be used as the element's namespace, otherwise -`*soap-default-xmlns*' will be used. +`soap-default-xmlns' will be used. This is needed because different parts of a WSDL document can use different namespace aliases for the same element." @@ -178,14 +178,14 @@ (cond ((string-match "^\\(.*\\):\\(.*\\)$" local-name-1) (let ((ns (match-string 1 local-name-1)) (name (match-string 2 local-name-1))) - (let ((namespace (cdr (assoc ns *soap-local-xmlns*)))) + (let ((namespace (cdr (assoc ns soap-local-xmlns)))) (if namespace (cons namespace name) (error "Soap-l2fq(%s): unknown alias %s" local-name ns))))) (t (cons (if use-tns - *soap-target-xmlns* - *soap-default-xmlns*) + soap-target-xmlns + soap-default-xmlns) local-name))))) (defun soap-extract-xmlns (node &optional xmlns-table) @@ -224,18 +224,18 @@ "Install a local alias table from NODE and execute BODY." (declare (debug (form &rest form)) (indent 1)) (let ((xmlns (make-symbol "xmlns"))) - `(let ((,xmlns (soap-extract-xmlns ,node *soap-local-xmlns*))) - (let ((*soap-default-xmlns* (or (nth 0 ,xmlns) *soap-default-xmlns*)) - (*soap-target-xmlns* (or (nth 1 ,xmlns) *soap-target-xmlns*)) - (*soap-local-xmlns* (nth 2 ,xmlns))) + `(let ((,xmlns (soap-extract-xmlns ,node soap-local-xmlns))) + (let ((soap-default-xmlns (or (nth 0 ,xmlns) soap-default-xmlns)) + (soap-target-xmlns (or (nth 1 ,xmlns) soap-target-xmlns)) + (soap-local-xmlns (nth 2 ,xmlns))) ,@body)))) (defun soap-get-target-namespace (node) "Return the target namespace of NODE. This is the namespace in which new elements will be defined." (or (xml-get-attribute-or-nil node 'targetNamespace) - (cdr (assoc "tns" *soap-local-xmlns*)) - *soap-target-xmlns*)) + (cdr (assoc "tns" soap-local-xmlns)) + soap-target-xmlns)) (defun soap-xml-get-children1 (node child-name) "Return the children of NODE named CHILD-NAME. @@ -477,7 +477,7 @@ (soap-wsdl-get \"foo\" WSDL 'soap-message-p) -If USE-LOCAL-ALIAS-TABLE is not nil, `*soap-local-xmlns*` will be +If USE-LOCAL-ALIAS-TABLE is not nil, `soap-local-xmlns` will be used to resolve the namespace alias." (let ((alias-table (soap-wsdl-alias-table wsdl)) namespace element-name element) @@ -486,7 +486,7 @@ (setq name (symbol-name name))) (when use-local-alias-table - (setq alias-table (append *soap-local-xmlns* alias-table))) + (setq alias-table (append soap-local-xmlns alias-table))) (cond ((consp name) ; a fully qualified name, as returned by `soap-l2fq' (setq element-name (cdr name)) @@ -780,7 +780,7 @@ ;; Add the local alias table to the wsdl document -- it will be used for ;; all types in this document even after we finish parsing it. - (setf (soap-wsdl-alias-table wsdl) *soap-local-xmlns*) + (setf (soap-wsdl-alias-table wsdl) soap-local-xmlns) ;; Add the XSD types to the wsdl document (let ((ns (soap-default-xsd-types))) @@ -1121,17 +1121,17 @@ ;;;; SOAP type decoding -(defvar *soap-multi-refs* nil +(defvar soap-multi-refs nil "The list of multi-ref nodes in the current SOAP response. This is a dynamically bound variable used during decoding the SOAP response.") -(defvar *soap-decoded-multi-refs* nil +(defvar soap-decoded-multi-refs nil "List of decoded multi-ref nodes in the current SOAP response. This is a dynamically bound variable used during decoding the SOAP response.") -(defvar *soap-current-wsdl* nil +(defvar soap-current-wsdl nil "The current WSDL document used when decoding the SOAP response. This is a dynamically bound variable.") @@ -1148,19 +1148,19 @@ ;; NODE is actually a HREF, find the target and decode that. ;; Check first if we already decoded this multiref. - (let ((decoded (cdr (assoc href *soap-decoded-multi-refs*)))) + (let ((decoded (cdr (assoc href soap-decoded-multi-refs)))) (when decoded (throw 'done decoded))) (string-match "^#\\(.*\\)$" href) ; TODO: check that it matched (let ((id (match-string 1 href))) - (dolist (mr *soap-multi-refs*) + (dolist (mr soap-multi-refs) (let ((mrid (xml-get-attribute mr 'id))) (when (equal id mrid) ;; recurse here, in case there are multiple HREF's (let ((decoded (soap-decode-type type mr))) - (push (cons href decoded) *soap-decoded-multi-refs*) + (push (cons href decoded) soap-decoded-multi-refs) (throw 'done decoded))))) (error "Cannot find href %s" href)))) (t @@ -1177,7 +1177,7 @@ ;; If the NODE has type information, we use that... (let ((type (soap-xml-get-attribute-or-nil1 node 'xsi:type))) (if type - (let ((wtype (soap-wsdl-get type *soap-current-wsdl* 'soap-type-p))) + (let ((wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p))) (if wtype (soap-decode-type wtype node) ;; The node has type info encoded in it, but we don't know how @@ -1210,7 +1210,7 @@ ;; Type is in the format "someType[NUM]" where NUM is the number of ;; elements in the array. We discard the [NUM] part. (setq type (replace-regexp-in-string "\\[[0-9]+\\]\\'" "" type)) - (setq wtype (soap-wsdl-get type *soap-current-wsdl* 'soap-type-p)) + (setq wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p)) (unless wtype ;; The node has type info encoded in it, but we don't know how to ;; decode it... @@ -1337,7 +1337,7 @@ SOAP-BODY is the body of the SOAP envelope (of which RESPONSE-NODE is a sub-node). It is used in case RESPONSE-NODE reference multiRef parts which are external to RESPONSE-NODE." - (let* ((*soap-current-wsdl* wsdl) + (let* ((soap-current-wsdl wsdl) (op (soap-bound-operation-operation operation)) (use (soap-bound-operation-use operation)) (message (cdr (soap-operation-output op)))) @@ -1354,8 +1354,8 @@ (soap-element-name message))))) (let ((decoded-parts nil) - (*soap-multi-refs* (xml-get-children soap-body 'multiRef)) - (*soap-decoded-multi-refs* nil)) + (soap-multi-refs (xml-get-children soap-body 'multiRef)) + (soap-decoded-multi-refs nil)) (dolist (part (soap-message-parts message)) (let ((tag (car part)) @@ -1390,7 +1390,7 @@ ;;;; SOAP type encoding -(defvar *soap-encoded-namespaces* nil +(defvar soap-encoded-namespaces nil "A list of namespace tags used during encoding a message. This list is populated by `soap-encode-value' and used by `soap-create-envelope' to add aliases for these namespace to the @@ -1414,7 +1414,7 @@ (when (symbolp xml-tag) (setq xml-tag (symbol-name xml-tag))) (funcall encoder xml-tag value type)) - (add-to-list '*soap-encoded-namespaces* (soap-element-namespace-tag type))) + (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type))) (defun soap-encode-basic-type (xml-tag value type) "Encode inside XML-TAG the LISP VALUE according to TYPE. @@ -1577,7 +1577,7 @@ (insert "\n") (when (eq use 'encoded) - (add-to-list '*soap-encoded-namespaces* (soap-element-namespace-tag op)) + (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag op)) (insert "<" (soap-element-fq-name op) ">\n")) (let ((param-table (loop for formal in parameter-order @@ -1613,7 +1613,7 @@ "Create a SOAP request envelope for OPERATION using PARAMETERS. WSDL is the wsdl document used to encode the PARAMETERS." (with-temp-buffer - (let ((*soap-encoded-namespaces* '("xsi" "soap" "soapenc")) + (let ((soap-encoded-namespaces '("xsi" "soap" "soapenc")) (use (soap-bound-operation-use operation))) ;; Create the request body @@ -1624,9 +1624,9 @@ (insert "\n branch nick: trunk timestamp: Wed 2011-02-16 20:41:31 +0100 message: * NEWS: Add soap-client.el and soap-inspect.el. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-02-13 12:57:41 +0000 +++ etc/ChangeLog 2011-02-16 19:41:31 +0000 @@ -1,3 +1,7 @@ +2011-02-16 Michael Albinus + + * NEWS: Add soap-client.el and soap-inspect.el. + 2011-02-13 Michael Albinus * NEWS: Tramp methods "imap" and "imaps" are discontinued. === modified file 'etc/NEWS' --- etc/NEWS 2011-02-14 17:21:10 +0000 +++ etc/NEWS 2011-02-16 19:41:31 +0000 @@ -639,6 +639,9 @@ ** notifications.el provides an implementation of the Desktop Notifications API. It requires D-Bus for communication. +** soap-client.el supports access to SOAP web services from Emacs. +soap-inspect.el is an interactive inspector for SOAP WSDL structures. + * Incompatible Lisp Changes in Emacs 24.1 ------------------------------------------------------------ revno: 103300 committer: Michael Albinus branch nick: trunk timestamp: Wed 2011-02-16 20:33:35 +0100 message: * net/soap-client.el: Add "comm" and "hypermedia" to the keywords. Reflow too long lines. * net/soap-inspect.el: Ditto. Require 'cl. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 16:55:21 +0000 +++ lisp/ChangeLog 2011-02-16 19:33:35 +0000 @@ -1,3 +1,10 @@ +2011-02-16 Michael Albinus + + * net/soap-client.el: Add "comm" and "hypermedia" to the + keywords. Reflow too long lines. + + * net/soap-inspect.el: Ditto. Require 'cl. + 2011-02-16 Bastien Guerry * play/doctor.el (doctor-mode): Bugfix: escape the "," character === modified file 'lisp/net/soap-client.el' --- lisp/net/soap-client.el 2011-02-16 09:25:37 +0000 +++ lisp/net/soap-client.el 2011-02-16 19:33:35 +0000 @@ -1,4 +1,4 @@ -;;;; soap.el -- Access SOAP web services from Emacs +;;;; soap-client.el -- Access SOAP web services from Emacs ;; Copyright (C) 2009-2011 Alex Harsanyi @@ -17,12 +17,12 @@ ;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) ;; Created: December, 2009 -;; Keywords: soap, web-services +;; Keywords: soap, web-services, comm, hypermedia ;; Homepage: http://code.google.com/p/emacs-soap-client ;; ;;; Commentary: -;; +;; ;; To use the SOAP client, you first need to load the WSDL document for the ;; service you want to access, using `soap-load-wsdl-from-url'. A WSDL ;; document describes the available operations of the SOAP service, how their @@ -157,14 +157,13 @@ nil))) ;; if no namespace is defined, just return the unqualified name name))) - + (defun soap-l2fq (local-name &optional use-tns) "Convert LOCAL-NAME into a fully qualified name. A fully qualified name is a cons of the namespace name and the name of the element itself. For example \"xsd:string\" is -converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\" -\). +converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\"\). The USE-TNS argument specifies what to do when LOCAL-NAME has no namespace tag. If USE-TNS is non-nil, the `*soap-target-xmlns*' @@ -201,14 +200,15 @@ (setq default-ns value)) ((string-match "^xmlns:\\(.*\\)$" name) (push (cons (match-string 1 name) value) xmlns))))) - + (let ((tns (assoc "tns" xmlns))) (cond ((and tns target-ns) - ;; If a tns alias is defined for this node, it must match the target - ;; namespace. + ;; If a tns alias is defined for this node, it must match + ;; the target namespace. (unless (equal target-ns (cdr tns)) - (soap-warning "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch" - (xml-node-name node)))) + (soap-warning + "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch" + (xml-node-name node)))) ((and tns (not target-ns)) (setq target-ns (cdr tns))) ((and (not tns) target-ns) @@ -217,7 +217,7 @@ ;; that we might override an existing tns alias in XMLNS-TABLE, ;; but that is intended. (push (cons "tns" target-ns) xmlns)))) - + (list default-ns target-ns (append xmlns xmlns-table)))) (defmacro soap-with-local-xmlns (node &rest body) @@ -248,7 +248,8 @@ ;; We use `ignore-errors' here because we want to silently ;; skip nodes for which we cannot convert them to a ;; well-known name. - (eq (ignore-errors (soap-l2wk (xml-node-name c))) child-name))) + (eq (ignore-errors (soap-l2wk (xml-node-name c))) + child-name))) (push c result))) (nreverse result))) @@ -346,7 +347,9 @@ (throw 'found e))))) ((= (length elements) 1) (car elements)) ((> (length elements) 1) - (error "Soap-namespace-get(%s): multiple elements, discriminant needed" name)) + (error + "Soap-namespace-get(%s): multiple elements, discriminant needed" + name)) (t nil)))) @@ -389,7 +392,8 @@ (defstruct soap-bound-operation operation ; SOAP-OPERATION soap-action ; value for SOAPAction HTTP header - use ; 'literal or 'encoded, see http://www.w3.org/TR/wsdl#_soap:body + use ; 'literal or 'encoded, see + ; http://www.w3.org/TR/wsdl#_soap:body ) (defstruct (soap-binding (:include soap-element)) @@ -412,7 +416,8 @@ (defun soap-default-soapenc-types () "Return a namespace containing some of the SOAPEnc types." - (let ((ns (make-soap-namespace :name "http://schemas.xmlsoap.org/soap/encoding/"))) + (let ((ns (make-soap-namespace + :name "http://schemas.xmlsoap.org/soap/encoding/"))) (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" "base64Binary" "anyType" "Array" "byte[]")) (soap-namespace-put @@ -425,7 +430,7 @@ (or (soap-basic-type-p element) (soap-sequence-type-p element) (soap-array-type-p element))) - + ;;;;; The WSDL document @@ -482,7 +487,7 @@ (when use-local-alias-table (setq alias-table (append *soap-local-xmlns* alias-table))) - + (cond ((consp name) ; a fully qualified name, as returned by `soap-l2fq' (setq element-name (cdr name)) (when (symbolp element-name) @@ -490,19 +495,21 @@ (setq namespace (soap-wsdl-find-namespace (car name) wsdl)) (unless namespace (error "Soap-wsdl-get(%s): unknown namespace: %s" name namespace))) - + ((string-match "^\\(.*\\):\\(.*\\)$" name) (setq element-name (match-string 2 name)) (let* ((ns-alias (match-string 1 name)) (ns-name (cdr (assoc ns-alias alias-table)))) (unless ns-name - (error "Soap-wsdl-get(%s): cannot find namespace alias %s" name ns-alias)) - + (error "Soap-wsdl-get(%s): cannot find namespace alias %s" + name ns-alias)) + (setq namespace (soap-wsdl-find-namespace ns-name wsdl)) (unless namespace - (error "Soap-wsdl-get(%s): unknown namespace %s, referenced by alias %s" - name ns-name ns-alias)))) + (error + "Soap-wsdl-get(%s): unknown namespace %s, referenced by alias %s" + name ns-name ns-alias)))) (t (error "Soap-wsdl-get(%s): bad name" name))) @@ -513,10 +520,10 @@ (or (funcall 'soap-namespace-link-p e) (funcall predicate e))) nil))) - + (unless element (error "Soap-wsdl-get(%s): cannot find element" name)) - + (if (soap-namespace-link-p element) ;; NOTE: don't use the local alias table here (soap-wsdl-get (soap-namespace-link-target element) wsdl predicate) @@ -597,7 +604,8 @@ (setq name (format "in%d" (incf counter)))) (when (or (consp message) (stringp message)) (setf (soap-operation-input operation) - (cons (intern name) (soap-wsdl-get message wsdl 'soap-message-p)))))) + (cons (intern name) + (soap-wsdl-get message wsdl 'soap-message-p)))))) (let ((output (soap-operation-output operation)) (counter 0)) @@ -607,7 +615,8 @@ (setq name (format "out%d" (incf counter)))) (when (or (consp message) (stringp message)) (setf (soap-operation-output operation) - (cons (intern name) (soap-wsdl-get message wsdl 'soap-message-p)))))) + (cons (intern name) + (soap-wsdl-get message wsdl 'soap-message-p)))))) (let ((resolved-faults nil) (counter 0)) @@ -617,7 +626,8 @@ (when (or (null name) (equal name "")) (setq name (format "fault%d" (incf counter)))) (if (or (consp message) (stringp message)) - (push (cons (intern name) (soap-wsdl-get message wsdl 'soap-message-p)) + (push (cons (intern name) + (soap-wsdl-get message wsdl 'soap-message-p)) resolved-faults) (push fault resolved-faults)))) (setf (soap-operation-faults operation) resolved-faults)) @@ -626,7 +636,7 @@ (setf (soap-operation-parameter-order operation) (mapcar 'car (soap-message-parts (cdr (soap-operation-input operation)))))) - + (setf (soap-operation-parameter-order operation) (mapcar (lambda (p) (if (stringp p) @@ -641,7 +651,8 @@ (when (or (consp (soap-binding-port-type binding)) (stringp (soap-binding-port-type binding))) (setf (soap-binding-port-type binding) - (soap-wsdl-get (soap-binding-port-type binding) wsdl 'soap-port-type-p))) + (soap-wsdl-get (soap-binding-port-type binding) + wsdl 'soap-port-type-p))) (let ((port-ops (soap-port-type-operations (soap-binding-port-type binding)))) (maphash (lambda (k v) @@ -801,7 +812,8 @@ (dolist (node (soap-xml-get-children1 node 'wsdl:portType)) (let ((port-type (soap-parse-port-type node))) (soap-namespace-put port-type ns) - (soap-wsdl-add-namespace (soap-port-type-operations port-type) wsdl))) + (soap-wsdl-add-namespace + (soap-port-type-operations port-type) wsdl))) (dolist (node (soap-xml-get-children1 node 'wsdl:binding)) (soap-namespace-put (soap-parse-binding node) ns)) @@ -810,10 +822,12 @@ (dolist (node (soap-xml-get-children1 node 'wsdl:port)) (let ((name (xml-get-attribute node 'name)) (binding (xml-get-attribute node 'binding)) - (url (let ((n (car (soap-xml-get-children1 node 'wsdlsoap:address)))) + (url (let ((n (car (soap-xml-get-children1 + node 'wsdlsoap:address)))) (xml-get-attribute n 'location)))) (let ((port (make-soap-port - :name name :binding (soap-l2fq binding 'tns) :service-url url))) + :name name :binding (soap-l2fq binding 'tns) + :service-url url))) (soap-namespace-put port ns) (push port (soap-wsdl-ports wsdl)))))) @@ -854,7 +868,8 @@ ;; construct the actual complex type for it. (let ((type-node (soap-xml-get-children1 node 'xsd:complexType))) (when (> (length type-node) 0) - (assert (= (length type-node) 1)) ; only one complex type definition per element + (assert (= (length type-node) 1)) ; only one complex type + ; definition per element (setq type (soap-parse-complex-type (car type-node))))) (setf (soap-element-name type) name) type)) @@ -919,7 +934,8 @@ (setq type (soap-parse-complex-type (car type-node)))))) (push (make-soap-sequence-element - :name (intern name) :type type :nillable? nillable? :multiple? multiple?) + :name (intern name) :type type :nillable? nillable? + :multiple? multiple?) elements))) (nreverse elements))) @@ -938,12 +954,14 @@ (soap-l2wk (xml-node-name node))) (let (array? parent elements) (let ((extension (car-safe (soap-xml-get-children1 node 'xsd:extension))) - (restriction (car-safe (soap-xml-get-children1 node 'xsd:restriction)))) + (restriction (car-safe + (soap-xml-get-children1 node 'xsd:restriction)))) ;; a complex content node is either an extension or a restriction (cond (extension (setq parent (xml-get-attribute-or-nil extension 'base)) (setq elements (soap-parse-sequence - (car (soap-xml-get-children1 extension 'xsd:sequence))))) + (car (soap-xml-get-children1 + extension 'xsd:sequence))))) (restriction (let ((base (xml-get-attribute-or-nil restriction 'base))) (assert (equal base "soapenc:Array") @@ -951,8 +969,10 @@ "restrictions supported only for soapenc:Array types, this is a %s" base)) (setq array? t) - (let ((attribute (car (soap-xml-get-children1 restriction 'xsd:attribute)))) - (let ((array-type (soap-xml-get-attribute-or-nil1 attribute 'wsdl:arrayType))) + (let ((attribute (car (soap-xml-get-children1 + restriction 'xsd:attribute)))) + (let ((array-type (soap-xml-get-attribute-or-nil1 + attribute 'wsdl:arrayType))) (when (string-match "^\\(.*\\)\\[\\]$" array-type) (setq parent (match-string 1 array-type)))))) @@ -961,7 +981,7 @@ (if parent (setq parent (soap-l2fq parent 'tns))) - + (if array? (make-soap-array-type :element-type parent) (make-soap-sequence-type :parent parent :elements elements)))) @@ -999,11 +1019,13 @@ (dolist (node (soap-xml-get-children1 node 'wsdl:operation)) (let ((o (soap-parse-operation node))) - (let ((other-operation (soap-namespace-get (soap-element-name o) ns 'soap-operation-p))) + (let ((other-operation (soap-namespace-get + (soap-element-name o) ns 'soap-operation-p))) (if other-operation ;; Unfortunately, the Confluence WSDL defines two operations ;; named "search" which differ only in parameter names... - (soap-warning "Discarding duplicate operation: %s" (soap-element-name o)) + (soap-warning "Discarding duplicate operation: %s" + (soap-element-name o)) (progn (soap-namespace-put o ns) @@ -1032,7 +1054,8 @@ "soap-parse-operation: expecting wsdl:operation node, got %s" (soap-l2wk (xml-node-name node))) (let ((name (xml-get-attribute node 'name)) - (parameter-order (split-string (xml-get-attribute node 'parameterOrder))) + (parameter-order (split-string + (xml-get-attribute node 'parameterOrder))) input output faults) (dolist (n (xml-node-children node)) (when (consp n) ; skip string nodes which are whitespace @@ -1065,7 +1088,8 @@ (soap-l2wk (xml-node-name node))) (let ((name (xml-get-attribute node 'name)) (type (xml-get-attribute node 'type))) - (let ((binding (make-soap-binding :name name :port-type (soap-l2fq type 'tns)))) + (let ((binding (make-soap-binding :name name + :port-type (soap-l2fq type 'tns)))) (dolist (wo (soap-xml-get-children1 node 'wsdl:operation)) (let ((name (xml-get-attribute wo 'name)) soap-action @@ -1144,7 +1168,8 @@ (if (equal (soap-xml-get-attribute-or-nil1 node 'xsi:nil) "true") nil (let ((decoder (get (aref type 0) 'soap-decoder))) - (assert decoder nil "no soap-decoder for %s type" (aref type 0)) + (assert decoder nil "no soap-decoder for %s type" + (aref type 0)) (funcall decoder type node)))))))) (defun soap-decode-any-type (node) @@ -1282,9 +1307,11 @@ (let ((fault (car (soap-xml-get-children1 body 'soap:Fault)))) (when fault - (let ((fault-code (let ((n (car (xml-get-children fault 'faultcode)))) + (let ((fault-code (let ((n (car (xml-get-children + fault 'faultcode)))) (car-safe (xml-node-children n)))) - (fault-string (let ((n (car (xml-get-children fault 'faultstring)))) + (fault-string (let ((n (car (xml-get-children + fault 'faultstring)))) (car-safe (xml-node-children n))))) (while t (signal 'soap-error (list fault-code fault-string)))))) @@ -1319,7 +1346,8 @@ (when (eq use 'encoded) (let* ((received-message-name (soap-l2fq (xml-node-name response-node))) - (received-message (soap-wsdl-get received-message-name wsdl 'soap-message-p))) + (received-message (soap-wsdl-get + received-message-name wsdl 'soap-message-p))) (unless (eq received-message message) (error "Unexpected message: got %s, expecting %s" received-message-name @@ -1342,12 +1370,15 @@ ((eq use 'literal) (catch 'found (let* ((ns-aliases (soap-wsdl-alias-table wsdl)) - (ns-name (cdr (assoc (soap-element-namespace-tag type) ns-aliases))) + (ns-name (cdr (assoc + (soap-element-namespace-tag type) + ns-aliases))) (fqname (cons ns-name (soap-element-name type)))) (dolist (c (xml-node-children response-node)) (when (consp c) (soap-with-local-xmlns c - (when (equal (soap-l2fq (xml-node-name c)) fqname) + (when (equal (soap-l2fq (xml-node-name c)) + fqname) (throw 'found c)))))))))) (unless node @@ -1402,8 +1433,9 @@ ((memq value '(t nil)) (setq xsi-type "xsd:boolean" basic-type 'boolean)) (t - (error "Soap-encode-basic-type(%s, %s, %s): cannot classify anyType value" - xml-tag value xsi-type)))) + (error + "Soap-encode-basic-type(%s, %s, %s): cannot classify anyType value" + xml-tag value xsi-type)))) (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") @@ -1425,13 +1457,15 @@ (>= (length value) 2) (numberp (nth 0 value)) (numberp (nth 1 value))) - ;; Value is a (current-time) style value, convert to a string + ;; Value is a (current-time) style value, convert + ;; to a string (insert (format-time-string "%Y-%m-%dT%H:%M:%S" value))) ((stringp value) (insert (url-insert-entities-in-string value))) (t - (error "Soap-encode-basic-type(%s, %s, %s): not a dateTime value" - xml-tag value xsi-type)))) + (error + "Soap-encode-basic-type(%s, %s, %s): not a dateTime value" + xml-tag value xsi-type)))) (boolean (unless (memq value '(t nil)) @@ -1444,7 +1478,7 @@ (error "Soap-encode-basic-type(%s, %s, %s): not an integer value" xml-tag value xsi-type)) (insert (number-to-string value))) - + (base64Binary (unless (stringp value) (error "Soap-encode-basic-type(%s, %s, %s): not a string value" @@ -1452,9 +1486,10 @@ (insert (base64-encode-string value))) (otherwise - (error "Soap-encode-basic-type(%s, %s, %s): don't know how to encode" - xml-tag value xsi-type)))) - + (error + "Soap-encode-basic-type(%s, %s, %s): don't know how to encode" + xml-tag value xsi-type)))) + (insert " xsi:nil=\"true\">")) (insert "\n"))) @@ -1487,12 +1522,14 @@ ;; Do some sanity checking (cond ((and (= instance-count 0) (not (soap-sequence-element-nillable? element))) - (soap-warning "While encoding %s: missing non-nillable slot %s" - (soap-element-name type) e-name)) + (soap-warning + "While encoding %s: missing non-nillable slot %s" + (soap-element-name type) e-name)) ((and (> instance-count 1) (not (soap-sequence-element-multiple? element))) - (soap-warning "While encoding %s: multiple slots named %s" - (soap-element-name type) e-name)))))))) + (soap-warning + "While encoding %s: multiple slots named %s" + (soap-element-name type) e-name)))))))) (insert " xsi:nil=\"true\">")) (insert "\n"))) @@ -1563,7 +1600,8 @@ (goto-char start-pos) (when (re-search-forward " ") (let* ((ns (soap-element-namespace-tag type)) - (namespace (cdr (assoc ns (soap-wsdl-alias-table wsdl))))) + (namespace (cdr (assoc ns + (soap-wsdl-alias-table wsdl))))) (when namespace (insert "xmlns=\"" namespace "\" "))))))))) @@ -1632,7 +1670,8 @@ (error "Unknown SOAP service: %s" service)) (let* ((binding (soap-port-binding port)) - (operation (gethash operation-name (soap-binding-operations binding)))) + (operation (gethash operation-name + (soap-binding-operations binding)))) (unless operation (error "No operation %s for SOAP service %s" operation-name service)) @@ -1645,9 +1684,13 @@ (url-request-coding-system 'utf-8) (url-http-attempt-keepalives t) (url-request-extra-headers (list - (cons "SOAPAction" (soap-bound-operation-soap-action operation)) - (cons "Content-Type" "text/xml; charset=utf-8")))) - (let ((buffer (url-retrieve-synchronously (soap-port-service-url port)))) + (cons "SOAPAction" + (soap-bound-operation-soap-action + operation)) + (cons "Content-Type" + "text/xml; charset=utf-8")))) + (let ((buffer (url-retrieve-synchronously + (soap-port-service-url port)))) (condition-case err (with-current-buffer buffer (declare (special url-http-response-status)) @@ -1657,9 +1700,12 @@ ;; This is a warning because some SOAP errors come ;; back with a HTTP response 500 (internal server ;; error) - (warn "Error in SOAP response: HTTP code %s" url-http-response-status)) + (warn "Error in SOAP response: HTTP code %s" + url-http-response-status)) (when (> (buffer-size) 1000000) - (soap-warning "Received large message: %s bytes" (buffer-size))) + (soap-warning + "Received large message: %s bytes" + (buffer-size))) (let ((mime-part (mm-dissect-buffer t t))) (unless mime-part (error "Failed to decode response from server")) @@ -1667,7 +1713,8 @@ (error "Server response is not an XML document")) (with-temp-buffer (mm-insert-part mime-part) - (let ((response (car (xml-parse-region (point-min) (point-max))))) + (let ((response (car (xml-parse-region + (point-min) (point-max))))) (prog1 (soap-parse-envelope response operation wsdl) (kill-buffer buffer) === modified file 'lisp/net/soap-inspect.el' --- lisp/net/soap-inspect.el 2011-02-16 09:25:37 +0000 +++ lisp/net/soap-inspect.el 2011-02-16 19:33:35 +0000 @@ -17,12 +17,12 @@ ;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) ;; Created: October 2010 -;; Keywords: soap, web-services +;; Keywords: soap, web-services, comm, hypermedia ;; Homepage: http://code.google.com/p/emacs-soap-client ;; ;;; Commentary: -;; +;; ;; This package provides an inspector for a WSDL document loaded with ;; `soap-load-wsdl' or `soap-load-wsdl-from-url'. To use it, evaluate: ;; @@ -32,11 +32,13 @@ ;; and types to explore the structure of the wsdl document. ;; + +;;; Code: + +(eval-when-compile (require 'cl)) + (require 'soap-client) - -;;; Code: - ;;; sample-value (defun soap-sample-value (type) @@ -148,12 +150,12 @@ (setq buffer-read-only t) (let ((inhibit-read-only t)) (erase-buffer) - + (when soap-inspect-current-item (push soap-inspect-current-item soap-inspect-previous-items)) (setq soap-inspect-current-item element) - + (funcall inspect element) (unless (null soap-inspect-previous-items) @@ -252,11 +254,13 @@ (insert "\tOutput: " (symbol-name (car output)) " (") (soap-insert-describe-button (cdr output)) (insert ")\n")) - + (insert "\n\nSample invocation:\n") - (let ((sample-message-value (soap-sample-value (cdr (soap-operation-input operation)))) + (let ((sample-message-value + (soap-sample-value (cdr (soap-operation-input operation)))) (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation)))) - (let ((sample-invocation (append funcall (mapcar 'cdr sample-message-value)))) + (let ((sample-invocation + (append funcall (mapcar 'cdr sample-message-value)))) (pp sample-invocation (current-buffer))))) (defun soap-inspect-port-type (port-type) @@ -335,7 +339,7 @@ 'soap-inspect-message) (put (aref (make-soap-operation) 0) 'soap-inspect 'soap-inspect-operation) - + (put (aref (make-soap-port-type) 0) 'soap-inspect 'soap-inspect-port-type) ------------------------------------------------------------ revno: 103299 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2011-02-16 21:09:20 +0200 message: Use KVAR in the MS-DOS build. msdos.c (internal_terminal_init): Use KVAR. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 18:49:57 +0000 +++ src/ChangeLog 2011-02-16 19:09:20 +0000 @@ -1,5 +1,7 @@ 2011-02-16 Eli Zaretskii + * msdos.c (internal_terminal_init): Use KVAR. + * w32fns.c (Fx_create_frame): Use KVAR. * w32term.c (w32_create_terminal): Use KVAR. === modified file 'src/msdos.c' --- src/msdos.c 2011-02-16 15:02:50 +0000 +++ src/msdos.c 2011-02-16 19:09:20 +0000 @@ -1793,7 +1793,7 @@ } tty = FRAME_TTY (sf); - current_kboard->Vwindow_system = Qpc; + KVAR (current_kboard, Vwindow_system) = Qpc; sf->output_method = output_msdos_raw; if (init_needed) { ------------------------------------------------------------ revno: 103298 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2011-02-16 20:49:57 +0200 message: Fix formatting of src/ChangeLog entries. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 18:47:21 +0000 +++ src/ChangeLog 2011-02-16 18:49:57 +0000 @@ -26,29 +26,30 @@ 2011-02-16 Tom Tromey - * callint.c (Fcall_interactively): Update. - * doc.c (Fsubstitute_command_keys): Update. - * cmds.c (Fself_insert_command): Update. + * callint.c (Fcall_interactively): Update for change to field names. + * doc.c (Fsubstitute_command_keys): Update for change to field names. + * cmds.c (Fself_insert_command): Update for change to field names. * keymap.c (Fcurrent_active_maps, Fkey_binding) - (Fdescribe_buffer_bindings): Update. + (Fdescribe_buffer_bindings): Update for change to field names. * macros.c (Fstart_kbd_macro, end_kbd_macro, Fend_kbd_macro) (store_kbd_macro_char, Fcall_last_kbd_macro, Fexecute_kbd_macro): - Update. + Update for change to field names. * keyboard.c (echo_char, echo_dash, echo_now, cancel_echoing) (echo_length, echo_truncate, cmd_error, command_loop_1) (read_char, kbd_buffer_store_event_hold, make_lispy_event) (menu_bar_items, tool_bar_items, read_char_minibuf_menu_prompt) (read_key_sequence, Fcommand_execute, Fexecute_extended_command) (Fdiscard_input, init_kboard, init_keyboard, mark_kboards): - Update. - * xfns.c (Fx_create_frame): Update. - * xterm.c (x_connection_closed, x_term_init): Update. + Update for change to field names. + * xfns.c (Fx_create_frame): Update for change to field names. + * xterm.c (x_connection_closed, x_term_init): Update for change to + field names. * term.c (term_get_fkeys_1, CONDITIONAL_REASSIGN, init_tty): - Update. + Update for change to field names. * window.c (window_scroll_pixel_based, window_scroll_line_based): - Update. + Update for change to field names. * frame.c (make_frame_without_minibuffer, Fhandle_switch_frame) - (delete_frame): Update. + (delete_frame): Update for change to field names. * lisp.h (DEFVAR_KBOARD): Update for change to field names. * keyboard.h (struct kboard): Rename all Lisp_Object fields. (KBOARD_INTERNAL_FIELD, KVAR): New macros. ------------------------------------------------------------ revno: 103297 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2011-02-16 20:47:21 +0200 message: src/s/ms-w32.h (getloadavg): Declare prototype which was removed from lisp.h. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 18:39:46 +0000 +++ src/ChangeLog 2011-02-16 18:47:21 +0000 @@ -5,6 +5,7 @@ * w32term.c (w32_create_terminal): Use KVAR. * s/ms-w32.h (MODE_LINE_BINARY_TEXT): Remove. + (getloadavg): Declare prototype which was removed from lisp.h. * xdisp.c (decode_mode_spec): Don't use MODE_LINE_BINARY_TEXT. === modified file 'src/s/ms-w32.h' --- src/s/ms-w32.h 2011-02-16 18:39:46 +0000 +++ src/s/ms-w32.h 2011-02-16 18:47:21 +0000 @@ -346,6 +346,8 @@ #endif #include +extern int getloadavg (double *, int); + /* We need a little extra space, see ../../lisp/loadup.el. */ #define SYSTEM_PURESIZE_EXTRA 50000 ------------------------------------------------------------ revno: 103296 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2011-02-16 20:39:46 +0200 message: Use KVAR in MS-Windows build, remove buffer-file-type. w32fns.c (Fx_create_frame): Use KVAR. w32term.c (w32_create_terminal): Use KVAR. s/ms-w32.h (MODE_LINE_BINARY_TEXT): Remove. xdisp.c (decode_mode_spec): Don't use MODE_LINE_BINARY_TEXT. fileio.c (Finsert_file_contents, Fwrite_region): Remove references to buffer_file_type. (syms_of_fileio): Don't intern and staticpro find-buffer-file-type. callproc.c (syms_of_callproc): Remove references to buffer_file_type. buffer.c (reset_buffer_local_variables): Don't set buffer_file_type. (init_buffer_once): Likewise. (syms_of_buffer): Don't define buffer-file-type. buffer.h (struct buffer): Remove buffer_file_type. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 16:35:16 +0000 +++ src/ChangeLog 2011-02-16 18:39:46 +0000 @@ -1,3 +1,28 @@ +2011-02-16 Eli Zaretskii + + * w32fns.c (Fx_create_frame): Use KVAR. + + * w32term.c (w32_create_terminal): Use KVAR. + + * s/ms-w32.h (MODE_LINE_BINARY_TEXT): Remove. + + * xdisp.c (decode_mode_spec): Don't use MODE_LINE_BINARY_TEXT. + + * fileio.c (Finsert_file_contents, Fwrite_region): Remove + references to buffer_file_type. + (syms_of_fileio): Don't intern and staticpro + find-buffer-file-type. + + * callproc.c (syms_of_callproc): Remove references to + buffer_file_type. + + * buffer.c (reset_buffer_local_variables): Don't set + buffer_file_type. + (init_buffer_once): Likewise. + (syms_of_buffer): Don't define buffer-file-type. + + * buffer.h (struct buffer): Remove buffer_file_type. + 2011-02-16 Tom Tromey * callint.c (Fcall_interactively): Update. === modified file 'src/buffer.c' --- src/buffer.c 2011-02-16 15:02:50 +0000 +++ src/buffer.c 2011-02-16 18:39:46 +0000 @@ -715,9 +715,6 @@ BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; BVAR (b, invisibility_spec) = Qt; -#ifndef DOS_NT - BVAR (b, buffer_file_type) = Qnil; -#endif /* Reset all (or most) per-buffer variables to their defaults. */ if (permanent_too) @@ -5040,9 +5037,6 @@ BVAR (&buffer_defaults, extra_line_spacing) = Qnil; BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt; -#ifdef DOS_NT - BVAR (&buffer_defaults, buffer_file_type) = Qnil; /* TEXT */ -#endif BVAR (&buffer_defaults, enable_multibyte_characters) = Qt; BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil; XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70); @@ -5112,11 +5106,6 @@ XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx; -#ifdef DOS_NT - XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_type), idx); - /* Make this one a permanent local. */ - buffer_permanent_local_flags[idx++] = 1; -#endif XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, cache_long_line_scans), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; @@ -5415,14 +5404,6 @@ doc: /* Default value of `case-fold-search' for buffers that don't override it. This is the same as (default-value 'case-fold-search). */); -#ifdef DOS_NT - DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-type", - buffer_file_type, - doc: /* Default file type for buffers that do not override it. -This is the same as (default-value 'buffer-file-type). -The file type is nil for text, t for binary. */); -#endif - DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width", left_margin_cols, doc: /* Default value of `left-margin-width' for buffers that don't override it. @@ -5673,15 +5654,6 @@ `truncate-partial-width-windows', since wrapping can make text readable in narrower windows. */); -#ifdef DOS_NT - DEFVAR_PER_BUFFER ("buffer-file-type", &BVAR (current_buffer, buffer_file_type), - Qnil, - doc: /* Non-nil if the visited file is a binary file. -This variable is meaningful on MS-DOG and Windows NT. -On those systems, it is automatically local in every buffer. -On other systems, this variable is normally always nil. */); -#endif - DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), make_number (Lisp_String), doc: /* Name of default directory of current buffer. Should end with slash. === modified file 'src/buffer.h' --- src/buffer.h 2011-02-16 15:02:50 +0000 +++ src/buffer.h 2011-02-16 18:39:46 +0000 @@ -662,12 +662,6 @@ Lisp_Object BUFFER_INTERNAL_FIELD (left_margin); /* Function to call when insert space past fill column. */ Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function); - /* nil: text, t: binary. - This value is meaningful only on certain operating systems. */ - /* Actually, we don't need this flag any more because end-of-line - is handled correctly according to the buffer-file-coding-system - of the buffer. Just keeping it for backward compatibility. */ - Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_type); /* Case table for case-conversion in this buffer. This char-table maps each char into its lower-case version. */ === modified file 'src/callproc.c' --- src/callproc.c 2011-02-16 15:02:50 +0000 +++ src/callproc.c 2011-02-16 18:39:46 +0000 @@ -74,10 +74,6 @@ /* Pattern used by call-process-region to make temp files. */ static Lisp_Object Vtemp_file_name_pattern; -#ifdef DOS_NT -Lisp_Object Qbuffer_file_type; -#endif /* DOS_NT */ - /* True if we are about to fork off a synchronous process or if we are waiting for it. */ int synch_process_alive; @@ -1535,11 +1531,6 @@ void syms_of_callproc (void) { -#ifdef DOS_NT - Qbuffer_file_type = intern_c_string ("buffer-file-type"); - staticpro (&Qbuffer_file_type); -#endif /* DOS_NT */ - #ifndef DOS_NT Vtemp_file_name_pattern = build_string ("emacsXXXXXX"); #elif defined (WINDOWSNT) === modified file 'src/fileio.c' --- src/fileio.c 2011-02-16 15:02:50 +0000 +++ src/fileio.c 2011-02-16 18:39:46 +0000 @@ -3075,10 +3075,6 @@ return (mtime1 > st.st_mtime) ? Qt : Qnil; } -#ifdef DOS_NT -Lisp_Object Qfind_buffer_file_type; -#endif /* DOS_NT */ - #ifndef READ_BUF_SIZE #define READ_BUF_SIZE (64 << 10) #endif @@ -4103,18 +4099,6 @@ /* Now INSERTED is measured in characters. */ -#ifdef DOS_NT - /* Use the conversion type to determine buffer-file-type - (find-buffer-file-type is now used to help determine the - conversion). */ - if ((VECTORP (CODING_ID_EOL_TYPE (coding.id)) - || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)) - && ! CODING_REQUIRE_DECODING (&coding)) - BVAR (current_buffer, buffer_file_type) = Qt; - else - BVAR (current_buffer, buffer_file_type) = Qnil; -#endif - handled: if (deferred_remove_unwind_protect) @@ -4484,9 +4468,6 @@ int quietly = !NILP (visit); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct buffer *given_buffer; -#ifdef DOS_NT - int buffer_file_type = O_BINARY; -#endif /* DOS_NT */ struct coding_system coding; if (current_buffer->base_buffer && visiting) @@ -4596,7 +4577,7 @@ desc = -1; if (!NILP (append)) #ifdef DOS_NT - desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0); + desc = emacs_open (fn, O_WRONLY | O_BINARY, 0); #else /* not DOS_NT */ desc = emacs_open (fn, O_WRONLY, 0); #endif /* not DOS_NT */ @@ -4604,7 +4585,7 @@ if (desc < 0 && (NILP (append) || errno == ENOENT)) #ifdef DOS_NT desc = emacs_open (fn, - O_WRONLY | O_CREAT | buffer_file_type + O_WRONLY | O_CREAT | O_BINARY | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC), S_IREAD | S_IWRITE); #else /* not DOS_NT */ @@ -5586,11 +5567,6 @@ Qexcl = intern_c_string ("excl"); staticpro (&Qexcl); -#ifdef DOS_NT - Qfind_buffer_file_type = intern_c_string ("find-buffer-file-type"); - staticpro (&Qfind_buffer_file_type); -#endif /* DOS_NT */ - DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, doc: /* *Coding system for encoding file names. If it is nil, `default-file-name-coding-system' (which see) is used. */); === modified file 'src/s/ms-w32.h' --- src/s/ms-w32.h 2011-02-14 17:35:21 +0000 +++ src/s/ms-w32.h 2011-02-16 18:39:46 +0000 @@ -181,8 +181,6 @@ #define HAVE_MENUS 1 #endif -#define MODE_LINE_BINARY_TEXT(_b_) (NILP (B_(_b_,buffer_file_type)) ? "T" : "B") - /* Get some redefinitions in place. */ #ifdef emacs === modified file 'src/w32fns.c' --- src/w32fns.c 2011-02-16 15:02:50 +0000 +++ src/w32fns.c 2011-02-16 18:39:46 +0000 @@ -4348,9 +4348,9 @@ /* Initialize `default-minibuffer-frame' in case this is the first frame on this terminal. */ if (FRAME_HAS_MINIBUF_P (f) - && (!FRAMEP (kb->Vdefault_minibuffer_frame) - || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) - kb->Vdefault_minibuffer_frame = frame; + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + KVAR (kb, Vdefault_minibuffer_frame) = frame; /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ === modified file 'src/w32term.c' --- src/w32term.c 2011-01-26 08:36:39 +0000 +++ src/w32term.c 2011-02-16 18:39:46 +0000 @@ -6082,7 +6082,7 @@ terminal like X does. */ terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = intern ("w32"); + KVAR (terminal->kboard, Vwindow_system) = intern ("w32"); terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; /* Don't let the initial kboard remain current longer than necessary. === modified file 'src/xdisp.c' --- src/xdisp.c 2011-02-16 15:02:50 +0000 +++ src/xdisp.c 2011-02-16 18:39:46 +0000 @@ -19585,11 +19585,7 @@ } case 't': /* indicate TEXT or BINARY */ -#ifdef MODE_LINE_BINARY_TEXT - return MODE_LINE_BINARY_TEXT (b); -#else return "T"; -#endif case 'z': /* coding-system (not including end-of-line format) */ ------------------------------------------------------------ revno: 103295 committer: Bastien Guerry branch nick: trunk timestamp: Wed 2011-02-16 17:55:21 +0100 message: play/doctor.el: bugfix for `doctor-mode'. * play/doctor.el (doctor-mode): Bugfix: escape the "," character in a `doctor-type' argument. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 09:25:37 +0000 +++ lisp/ChangeLog 2011-02-16 16:55:21 +0000 @@ -1,3 +1,8 @@ +2011-02-16 Bastien Guerry + + * play/doctor.el (doctor-mode): Bugfix: escape the "," character + in a `doctor-type' argument. + 2011-02-16 Alex Harsanyi * net/soap-client.el: === modified file 'lisp/play/doctor.el' --- lisp/play/doctor.el 2011-01-26 08:36:39 +0000 +++ lisp/play/doctor.el 2011-02-16 16:55:21 +0000 @@ -141,7 +141,7 @@ (turn-on-auto-fill) (doctor-type '(i am the psychotherapist \. (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. - each time you are finished talking, type \R\E\T twice \.)) + each time you are finished talking\, type \R\E\T twice \.)) (insert "\n")) (defun make-doctor-variables () ------------------------------------------------------------ revno: 103294 committer: Tom Tromey branch nick: trunk timestamp: Wed 2011-02-16 09:35:16 -0700 message: Hide implementation of `struct kboard' * callint.c (Fcall_interactively): Update. * doc.c (Fsubstitute_command_keys): Update. * cmds.c (Fself_insert_command): Update. * keymap.c (Fcurrent_active_maps, Fkey_binding) (Fdescribe_buffer_bindings): Update. * macros.c (Fstart_kbd_macro, end_kbd_macro, Fend_kbd_macro) (store_kbd_macro_char, Fcall_last_kbd_macro, Fexecute_kbd_macro): Update. * keyboard.c (echo_char, echo_dash, echo_now, cancel_echoing) (echo_length, echo_truncate, cmd_error, command_loop_1) (read_char, kbd_buffer_store_event_hold, make_lispy_event) (menu_bar_items, tool_bar_items, read_char_minibuf_menu_prompt) (read_key_sequence, Fcommand_execute, Fexecute_extended_command) (Fdiscard_input, init_kboard, init_keyboard, mark_kboards): Update. * xfns.c (Fx_create_frame): Update. * xterm.c (x_connection_closed, x_term_init): Update. * term.c (term_get_fkeys_1, CONDITIONAL_REASSIGN, init_tty): Update. * window.c (window_scroll_pixel_based, window_scroll_line_based): Update. * frame.c (make_frame_without_minibuffer, Fhandle_switch_frame) (delete_frame): Update. * lisp.h (DEFVAR_KBOARD): Update for change to field names. * keyboard.h (struct kboard): Rename all Lisp_Object fields. (KBOARD_INTERNAL_FIELD, KVAR): New macros. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 15:20:08 +0000 +++ src/ChangeLog 2011-02-16 16:35:16 +0000 @@ -1,3 +1,32 @@ +2011-02-16 Tom Tromey + + * callint.c (Fcall_interactively): Update. + * doc.c (Fsubstitute_command_keys): Update. + * cmds.c (Fself_insert_command): Update. + * keymap.c (Fcurrent_active_maps, Fkey_binding) + (Fdescribe_buffer_bindings): Update. + * macros.c (Fstart_kbd_macro, end_kbd_macro, Fend_kbd_macro) + (store_kbd_macro_char, Fcall_last_kbd_macro, Fexecute_kbd_macro): + Update. + * keyboard.c (echo_char, echo_dash, echo_now, cancel_echoing) + (echo_length, echo_truncate, cmd_error, command_loop_1) + (read_char, kbd_buffer_store_event_hold, make_lispy_event) + (menu_bar_items, tool_bar_items, read_char_minibuf_menu_prompt) + (read_key_sequence, Fcommand_execute, Fexecute_extended_command) + (Fdiscard_input, init_kboard, init_keyboard, mark_kboards): + Update. + * xfns.c (Fx_create_frame): Update. + * xterm.c (x_connection_closed, x_term_init): Update. + * term.c (term_get_fkeys_1, CONDITIONAL_REASSIGN, init_tty): + Update. + * window.c (window_scroll_pixel_based, window_scroll_line_based): + Update. + * frame.c (make_frame_without_minibuffer, Fhandle_switch_frame) + (delete_frame): Update. + * lisp.h (DEFVAR_KBOARD): Update for change to field names. + * keyboard.h (struct kboard): Rename all Lisp_Object fields. + (KBOARD_INTERNAL_FIELD, KVAR): New macros. + 2011-02-16 Tom Tromey * lisp.h (DEFVAR_BUFFER_DEFAULTS): Use BVAR. === modified file 'src/callint.c' --- src/callint.c 2011-02-16 15:02:50 +0000 +++ src/callint.c 2011-02-16 16:35:16 +0000 @@ -280,7 +280,7 @@ save_this_command = Vthis_command; save_this_original_command = Vthis_original_command; save_real_this_command = real_this_command; - save_last_command = current_kboard->Vlast_command; + save_last_command = KVAR (current_kboard, Vlast_command); if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; @@ -363,7 +363,7 @@ Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; real_this_command= save_real_this_command; - current_kboard->Vlast_command = save_last_command; + KVAR (current_kboard, Vlast_command) = save_last_command; temporarily_switch_to_single_kboard (NULL); return unbind_to (speccount, apply1 (function, specs)); @@ -832,7 +832,7 @@ Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; real_this_command= save_real_this_command; - current_kboard->Vlast_command = save_last_command; + KVAR (current_kboard, Vlast_command) = save_last_command; { Lisp_Object val; === modified file 'src/cmds.c' --- src/cmds.c 2011-02-16 15:02:50 +0000 +++ src/cmds.c 2011-02-16 16:35:16 +0000 @@ -277,7 +277,7 @@ int remove_boundary = 1; CHECK_NATNUM (n); - if (!EQ (Vthis_command, current_kboard->Vlast_command)) + if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command))) nonundocount = 0; if (NILP (Vexecuting_kbd_macro) === modified file 'src/doc.c' --- src/doc.c 2011-02-06 01:56:00 +0000 +++ src/doc.c 2011-02-16 16:35:16 +0000 @@ -719,7 +719,7 @@ or a specified local map (which means search just that and the global map). If non-nil, it might come from Voverriding_local_map, or from a \\ construct in STRING itself.. */ - keymap = current_kboard->Voverriding_terminal_local_map; + keymap = KVAR (current_kboard, Voverriding_terminal_local_map); if (NILP (keymap)) keymap = Voverriding_local_map; === modified file 'src/frame.c' --- src/frame.c 2011-02-16 15:02:50 +0000 +++ src/frame.c 2011-02-16 16:35:16 +0000 @@ -428,20 +428,20 @@ if (NILP (mini_window)) { /* Use default-minibuffer-frame if possible. */ - if (!FRAMEP (kb->Vdefault_minibuffer_frame) - || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) + if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))) { Lisp_Object frame_dummy; XSETFRAME (frame_dummy, f); GCPRO1 (frame_dummy); /* If there's no minibuffer frame to use, create one. */ - kb->Vdefault_minibuffer_frame = + KVAR (kb, Vdefault_minibuffer_frame) = call1 (intern ("make-initial-minibuffer-frame"), display); UNGCPRO; } - mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; + mini_window = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window; } f->minibuffer_window = mini_window; @@ -889,7 +889,7 @@ (Lisp_Object event) { /* Preserve prefix arg that the command loop just cleared. */ - current_kboard->Vprefix_arg = Vcurrent_prefix_arg; + KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg; call1 (Vrun_hooks, Qmouse_leave_buffer_hook); return do_switch_frame (event, 0, 0, Qnil); } @@ -1526,7 +1526,7 @@ /* If we've deleted this keyboard's default_minibuffer_frame, try to find another one. Prefer minibuffer-only frames, but also notice frames with other windows. */ - if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame)) + if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame))) { Lisp_Object frames; @@ -1575,11 +1575,11 @@ if (NILP (frame_with_minibuf)) abort (); - kb->Vdefault_minibuffer_frame = frame_with_minibuf; + KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf; } else /* No frames left on this kboard--say no minibuffer either. */ - kb->Vdefault_minibuffer_frame = Qnil; + KVAR (kb, Vdefault_minibuffer_frame) = Qnil; } /* Cause frame titles to update--necessary if we now have just one frame. */ === modified file 'src/keyboard.c' --- src/keyboard.c 2011-02-16 15:02:50 +0000 +++ src/keyboard.c 2011-02-16 16:35:16 +0000 @@ -461,7 +461,7 @@ char *ptr = buffer; Lisp_Object echo_string; - echo_string = current_kboard->echo_string; + echo_string = KVAR (current_kboard, echo_string); /* If someone has passed us a composite event, use its head symbol. */ c = EVENT_HEAD (c); @@ -528,7 +528,7 @@ else if (STRINGP (echo_string)) echo_string = concat2 (echo_string, build_string (" ")); - current_kboard->echo_string + KVAR (current_kboard, echo_string) = concat2 (echo_string, make_string (buffer, ptr - buffer)); echo_now (); @@ -542,31 +542,31 @@ echo_dash (void) { /* Do nothing if not echoing at all. */ - if (NILP (current_kboard->echo_string)) + if (NILP (KVAR (current_kboard, echo_string))) return; if (this_command_key_count == 0) return; if (!current_kboard->immediate_echo - && SCHARS (current_kboard->echo_string) == 0) + && SCHARS (KVAR (current_kboard, echo_string)) == 0) return; /* Do nothing if we just printed a prompt. */ if (current_kboard->echo_after_prompt - == SCHARS (current_kboard->echo_string)) + == SCHARS (KVAR (current_kboard, echo_string))) return; /* Do nothing if we have already put a dash at the end. */ - if (SCHARS (current_kboard->echo_string) > 1) + if (SCHARS (KVAR (current_kboard, echo_string)) > 1) { Lisp_Object last_char, prev_char, idx; - idx = make_number (SCHARS (current_kboard->echo_string) - 2); - prev_char = Faref (current_kboard->echo_string, idx); + idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2); + prev_char = Faref (KVAR (current_kboard, echo_string), idx); - idx = make_number (SCHARS (current_kboard->echo_string) - 1); - last_char = Faref (current_kboard->echo_string, idx); + idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1); + last_char = Faref (KVAR (current_kboard, echo_string), idx); if (XINT (last_char) == '-' && XINT (prev_char) != ' ') return; @@ -574,7 +574,7 @@ /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ - current_kboard->echo_string = concat2 (current_kboard->echo_string, + KVAR (current_kboard, echo_string) = concat2 (KVAR (current_kboard, echo_string), build_string ("-")); echo_now (); } @@ -617,9 +617,9 @@ } echoing = 1; - message3_nolog (current_kboard->echo_string, - SBYTES (current_kboard->echo_string), - STRING_MULTIBYTE (current_kboard->echo_string)); + message3_nolog (KVAR (current_kboard, echo_string), + SBYTES (KVAR (current_kboard, echo_string)), + STRING_MULTIBYTE (KVAR (current_kboard, echo_string))); echoing = 0; /* Record in what buffer we echoed, and from which kboard. */ @@ -637,7 +637,7 @@ { current_kboard->immediate_echo = 0; current_kboard->echo_after_prompt = -1; - current_kboard->echo_string = Qnil; + KVAR (current_kboard, echo_string) = Qnil; ok_to_echo_at_next_pause = NULL; echo_kboard = NULL; echo_message_buffer = Qnil; @@ -648,8 +648,8 @@ static int echo_length (void) { - return (STRINGP (current_kboard->echo_string) - ? SCHARS (current_kboard->echo_string) + return (STRINGP (KVAR (current_kboard, echo_string)) + ? SCHARS (KVAR (current_kboard, echo_string)) : 0); } @@ -660,9 +660,9 @@ static void echo_truncate (EMACS_INT nchars) { - if (STRINGP (current_kboard->echo_string)) - current_kboard->echo_string - = Fsubstring (current_kboard->echo_string, + if (STRINGP (KVAR (current_kboard, echo_string))) + KVAR (current_kboard, echo_string) + = Fsubstring (KVAR (current_kboard, echo_string), make_number (0), make_number (nchars)); truncate_echo_area (nchars); } @@ -993,8 +993,8 @@ Vstandard_input = Qt; Vexecuting_kbd_macro = Qnil; executing_kbd_macro = Qnil; - current_kboard->Vprefix_arg = Qnil; - current_kboard->Vlast_prefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; + KVAR (current_kboard, Vlast_prefix_arg) = Qnil; cancel_echoing (); /* Avoid unquittable loop if data contains a circular list. */ @@ -1302,8 +1302,8 @@ #endif int already_adjusted = 0; - current_kboard->Vprefix_arg = Qnil; - current_kboard->Vlast_prefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; + KVAR (current_kboard, Vlast_prefix_arg) = Qnil; Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); @@ -1331,10 +1331,10 @@ } /* Do this after running Vpost_command_hook, for consistency. */ - current_kboard->Vlast_command = Vthis_command; - current_kboard->Vreal_last_command = real_this_command; + KVAR (current_kboard, Vlast_command) = Vthis_command; + KVAR (current_kboard, Vreal_last_command) = real_this_command; if (!CONSP (last_command_event)) - current_kboard->Vlast_repeatable_command = real_this_command; + KVAR (current_kboard, Vlast_repeatable_command) = real_this_command; while (1) { @@ -1504,9 +1504,9 @@ keys = Fkey_description (keys, Qnil); bitch_at_user (); message_with_string ("%s is undefined", keys, 0); - current_kboard->defining_kbd_macro = Qnil; + KVAR (current_kboard, defining_kbd_macro) = Qnil; update_mode_lines = 1; - current_kboard->Vprefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; } else { @@ -1523,7 +1523,7 @@ } #endif - if (NILP (current_kboard->Vprefix_arg)) /* FIXME: Why? --Stef */ + if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ Fundo_boundary (); Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil); @@ -1537,7 +1537,7 @@ unbind_to (scount, Qnil); #endif } - current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg; + KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg; /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ @@ -1565,12 +1565,12 @@ If the command didn't actually create a prefix arg, but is merely a frame event that is transparent to prefix args, then the above doesn't apply. */ - if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_event)) + if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event)) { - current_kboard->Vlast_command = Vthis_command; - current_kboard->Vreal_last_command = real_this_command; + KVAR (current_kboard, Vlast_command) = Vthis_command; + KVAR (current_kboard, Vreal_last_command) = real_this_command; if (!CONSP (last_command_event)) - current_kboard->Vlast_repeatable_command = real_this_command; + KVAR (current_kboard, Vlast_repeatable_command) = real_this_command; cancel_echoing (); this_command_key_count = 0; this_command_key_count_reset = 0; @@ -1649,8 +1649,8 @@ /* Install chars successfully executed in kbd macro. */ - if (!NILP (current_kboard->defining_kbd_macro) - && NILP (current_kboard->Vprefix_arg)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro)) + && NILP (KVAR (current_kboard, Vprefix_arg))) finalize_kbd_macro_chars (); #if 0 /* This shouldn't be necessary anymore. --lorentey */ if (!was_locked) @@ -2461,7 +2461,7 @@ KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame)); if (kb != current_kboard) { - Lisp_Object link = kb->kbd_queue; + Lisp_Object link = KVAR (kb, kbd_queue); /* We shouldn't get here if we were in single-kboard mode! */ if (single_kboard) abort (); @@ -2473,7 +2473,7 @@ abort (); } if (!CONSP (link)) - kb->kbd_queue = Fcons (c, Qnil); + KVAR (kb, kbd_queue) = Fcons (c, Qnil); else XSETCDR (link, Fcons (c, Qnil)); kb->kbd_queue_has_data = 1; @@ -2645,12 +2645,12 @@ { if (current_kboard->kbd_queue_has_data) { - if (!CONSP (current_kboard->kbd_queue)) + if (!CONSP (KVAR (current_kboard, kbd_queue))) abort (); - c = XCAR (current_kboard->kbd_queue); - current_kboard->kbd_queue - = XCDR (current_kboard->kbd_queue); - if (NILP (current_kboard->kbd_queue)) + c = XCAR (KVAR (current_kboard, kbd_queue)); + KVAR (current_kboard, kbd_queue) + = XCDR (KVAR (current_kboard, kbd_queue)); + if (NILP (KVAR (current_kboard, kbd_queue))) current_kboard->kbd_queue_has_data = 0; input_pending = readable_events (0); if (EVENT_HAS_PARAMETERS (c) @@ -2712,7 +2712,7 @@ if (! NILP (c) && (kb != current_kboard)) { - Lisp_Object link = kb->kbd_queue; + Lisp_Object link = KVAR (kb, kbd_queue); if (CONSP (link)) { while (CONSP (XCDR (link))) @@ -2721,7 +2721,7 @@ abort (); } if (!CONSP (link)) - kb->kbd_queue = Fcons (c, Qnil); + KVAR (kb, kbd_queue) = Fcons (c, Qnil); else XSETCDR (link, Fcons (c, Qnil)); kb->kbd_queue_has_data = 1; @@ -2829,15 +2829,15 @@ if (XINT (c) == -1) goto exit; - if ((STRINGP (current_kboard->Vkeyboard_translate_table) - && SCHARS (current_kboard->Vkeyboard_translate_table) > (unsigned) XFASTINT (c)) - || (VECTORP (current_kboard->Vkeyboard_translate_table) - && XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c)) - || (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table) + if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) + && SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)) > (unsigned) XFASTINT (c)) + || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table)) + && XVECTOR (KVAR (current_kboard, Vkeyboard_translate_table))->size > (unsigned) XFASTINT (c)) + || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table)) && CHARACTERP (c))) { Lisp_Object d; - d = Faref (current_kboard->Vkeyboard_translate_table, c); + d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c); /* nil in keyboard-translate-table means no translation. */ if (!NILP (d)) c = d; @@ -2918,7 +2918,7 @@ /* Save the echo status. */ int saved_immediate_echo = current_kboard->immediate_echo; struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause; - Lisp_Object saved_echo_string = current_kboard->echo_string; + Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string); int saved_echo_after_prompt = current_kboard->echo_after_prompt; #if 0 @@ -2973,7 +2973,7 @@ cancel_echoing (); ok_to_echo_at_next_pause = saved_ok_to_echo; - current_kboard->echo_string = saved_echo_string; + KVAR (current_kboard, echo_string) = saved_echo_string; current_kboard->echo_after_prompt = saved_echo_after_prompt; if (saved_immediate_echo) echo_now (); @@ -3459,7 +3459,7 @@ if (single_kboard && kb != current_kboard) { - kb->kbd_queue + KVAR (kb, kbd_queue) = Fcons (make_lispy_switch_frame (event->frame_or_window), Fcons (make_number (c), Qnil)); kb->kbd_queue_has_data = 1; @@ -5322,13 +5322,13 @@ { /* We need to use an alist rather than a vector as the cache since we can't make a vector long enuf. */ - if (NILP (current_kboard->system_key_syms)) - current_kboard->system_key_syms = Fcons (Qnil, Qnil); + if (NILP (KVAR (current_kboard, system_key_syms))) + KVAR (current_kboard, system_key_syms) = Fcons (Qnil, Qnil); return modify_event_symbol (event->code, event->modifiers, Qfunction_key, - current_kboard->Vsystem_key_alist, - 0, ¤t_kboard->system_key_syms, + KVAR (current_kboard, Vsystem_key_alist), + 0, &KVAR (current_kboard, system_key_syms), (unsigned) -1); } @@ -7360,8 +7360,8 @@ /* Yes, use them (if non-nil) as well as the global map. */ maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); nmaps = 0; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); if (!NILP (Voverriding_local_map)) maps[nmaps++] = Voverriding_local_map; } @@ -7897,8 +7897,8 @@ /* Yes, use them (if non-nil) as well as the global map. */ maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); nmaps = 0; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); if (!NILP (Voverriding_local_map)) maps[nmaps++] = Voverriding_local_map; } @@ -8614,12 +8614,12 @@ is pressed. Help characters are not recorded because menu prompting is not used on replay. */ - orig_defn_macro = current_kboard->defining_kbd_macro; - current_kboard->defining_kbd_macro = Qnil; + orig_defn_macro = KVAR (current_kboard, defining_kbd_macro); + KVAR (current_kboard, defining_kbd_macro) = Qnil; do obj = read_char (commandflag, 0, 0, Qt, 0, NULL); while (BUFFERP (obj)); - current_kboard->defining_kbd_macro = orig_defn_macro; + KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro; if (!INTEGERP (obj)) return obj; @@ -8632,7 +8632,7 @@ && (!INTEGERP (menu_prompt_more_char) || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) { - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) store_kbd_macro_char (obj); return obj; } @@ -8974,7 +8974,7 @@ /* Install the string STR as the beginning of the string of echoing, so that it serves as a prompt for the next character. */ - current_kboard->echo_string = prompt; + KVAR (current_kboard, echo_string) = prompt; current_kboard->echo_after_prompt = SCHARS (prompt); echo_now (); } @@ -9012,8 +9012,8 @@ happens if we switch keyboards between rescans. */ replay_entire_sequence: - indec.map = indec.parent = current_kboard->Vinput_decode_map; - fkey.map = fkey.parent = current_kboard->Vlocal_function_key_map; + indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map); + fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map); keytran.map = keytran.parent = Vkey_translation_map; indec.start = indec.end = 0; fkey.start = fkey.end = 0; @@ -9034,7 +9034,7 @@ the initial keymaps from the current buffer. */ nmaps = 0; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) { if (2 > nmaps_allocated) { @@ -9042,7 +9042,7 @@ defs = (Lisp_Object *) alloca (2 * sizeof (defs[0])); nmaps_allocated = 2; } - submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + submaps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); } else if (!NILP (Voverriding_local_map)) { @@ -9218,29 +9218,29 @@ if (!NILP (delayed_switch_frame)) { - interrupted_kboard->kbd_queue + KVAR (interrupted_kboard, kbd_queue) = Fcons (delayed_switch_frame, - interrupted_kboard->kbd_queue); + KVAR (interrupted_kboard, kbd_queue)); delayed_switch_frame = Qnil; } while (t > 0) - interrupted_kboard->kbd_queue - = Fcons (keybuf[--t], interrupted_kboard->kbd_queue); + KVAR (interrupted_kboard, kbd_queue) + = Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)); /* If the side queue is non-empty, ensure it begins with a switch-frame, so we'll replay it in the right context. */ - if (CONSP (interrupted_kboard->kbd_queue) - && (key = XCAR (interrupted_kboard->kbd_queue), + if (CONSP (KVAR (interrupted_kboard, kbd_queue)) + && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)), !(EVENT_HAS_PARAMETERS (key) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame)))) { Lisp_Object frame; XSETFRAME (frame, interrupted_frame); - interrupted_kboard->kbd_queue + KVAR (interrupted_kboard, kbd_queue) = Fcons (make_lispy_switch_frame (frame), - interrupted_kboard->kbd_queue); + KVAR (interrupted_kboard, kbd_queue)); } mock_input = 0; orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); @@ -10115,9 +10115,9 @@ if (NILP (special)) { - prefixarg = current_kboard->Vprefix_arg; + prefixarg = KVAR (current_kboard, Vprefix_arg); Vcurrent_prefix_arg = prefixarg; - current_kboard->Vprefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; } else prefixarg = Qnil; @@ -10251,7 +10251,7 @@ UNGCPRO; function = Fintern (function, Qnil); - current_kboard->Vprefix_arg = prefixarg; + KVAR (current_kboard, Vprefix_arg) = prefixarg; Vthis_command = function; real_this_command = function; @@ -10574,7 +10574,7 @@ Also end any kbd macro being defined. */) (void) { - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) { /* Discard the last command from the macro. */ Fcancel_kbd_macro_events (); @@ -11224,30 +11224,30 @@ void init_kboard (KBOARD *kb) { - kb->Voverriding_terminal_local_map = Qnil; - kb->Vlast_command = Qnil; - kb->Vreal_last_command = Qnil; - kb->Vkeyboard_translate_table = Qnil; - kb->Vlast_repeatable_command = Qnil; - kb->Vprefix_arg = Qnil; - kb->Vlast_prefix_arg = Qnil; - kb->kbd_queue = Qnil; + KVAR (kb, Voverriding_terminal_local_map) = Qnil; + KVAR (kb, Vlast_command) = Qnil; + KVAR (kb, Vreal_last_command) = Qnil; + KVAR (kb, Vkeyboard_translate_table) = Qnil; + KVAR (kb, Vlast_repeatable_command) = Qnil; + KVAR (kb, Vprefix_arg) = Qnil; + KVAR (kb, Vlast_prefix_arg) = Qnil; + KVAR (kb, kbd_queue) = Qnil; kb->kbd_queue_has_data = 0; kb->immediate_echo = 0; - kb->echo_string = Qnil; + KVAR (kb, echo_string) = Qnil; kb->echo_after_prompt = -1; kb->kbd_macro_buffer = 0; kb->kbd_macro_bufsize = 0; - kb->defining_kbd_macro = Qnil; - kb->Vlast_kbd_macro = Qnil; + KVAR (kb, defining_kbd_macro) = Qnil; + KVAR (kb, Vlast_kbd_macro) = Qnil; kb->reference_count = 0; - kb->Vsystem_key_alist = Qnil; - kb->system_key_syms = Qnil; - kb->Vwindow_system = Qt; /* Unset. */ - kb->Vinput_decode_map = Fmake_sparse_keymap (Qnil); - kb->Vlocal_function_key_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (kb->Vlocal_function_key_map, Vfunction_key_map); - kb->Vdefault_minibuffer_frame = Qnil; + KVAR (kb, Vsystem_key_alist) = Qnil; + KVAR (kb, system_key_syms) = Qnil; + KVAR (kb, Vwindow_system) = Qt; /* Unset. */ + KVAR (kb, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); + KVAR (kb, Vlocal_function_key_map) = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map); + KVAR (kb, Vdefault_minibuffer_frame) = Qnil; } /* @@ -11323,7 +11323,7 @@ init_kboard (current_kboard); /* A value of nil for Vwindow_system normally means a tty, but we also use it for the initial terminal since there is no window system there. */ - current_kboard->Vwindow_system = Qnil; + KVAR (current_kboard, Vwindow_system) = Qnil; if (!noninteractive) { @@ -12266,23 +12266,23 @@ if (kb->kbd_macro_buffer) for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) mark_object (*p); - mark_object (kb->Voverriding_terminal_local_map); - mark_object (kb->Vlast_command); - mark_object (kb->Vreal_last_command); - mark_object (kb->Vkeyboard_translate_table); - mark_object (kb->Vlast_repeatable_command); - mark_object (kb->Vprefix_arg); - mark_object (kb->Vlast_prefix_arg); - mark_object (kb->kbd_queue); - mark_object (kb->defining_kbd_macro); - mark_object (kb->Vlast_kbd_macro); - mark_object (kb->Vsystem_key_alist); - mark_object (kb->system_key_syms); - mark_object (kb->Vwindow_system); - mark_object (kb->Vinput_decode_map); - mark_object (kb->Vlocal_function_key_map); - mark_object (kb->Vdefault_minibuffer_frame); - mark_object (kb->echo_string); + mark_object (KVAR (kb, Voverriding_terminal_local_map)); + mark_object (KVAR (kb, Vlast_command)); + mark_object (KVAR (kb, Vreal_last_command)); + mark_object (KVAR (kb, Vkeyboard_translate_table)); + mark_object (KVAR (kb, Vlast_repeatable_command)); + mark_object (KVAR (kb, Vprefix_arg)); + mark_object (KVAR (kb, Vlast_prefix_arg)); + mark_object (KVAR (kb, kbd_queue)); + mark_object (KVAR (kb, defining_kbd_macro)); + mark_object (KVAR (kb, Vlast_kbd_macro)); + mark_object (KVAR (kb, Vsystem_key_alist)); + mark_object (KVAR (kb, system_key_syms)); + mark_object (KVAR (kb, Vwindow_system)); + mark_object (KVAR (kb, Vinput_decode_map)); + mark_object (KVAR (kb, Vlocal_function_key_map)); + mark_object (KVAR (kb, Vdefault_minibuffer_frame)); + mark_object (KVAR (kb, echo_string)); } { struct input_event *event; === modified file 'src/keyboard.h' --- src/keyboard.h 2011-02-14 16:25:04 +0000 +++ src/keyboard.h 2011-02-16 16:35:16 +0000 @@ -19,6 +19,15 @@ #include "systime.h" /* for EMACS_TIME */ #include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */ +/* Lisp fields in struct keyboard are hidden from most code and accessed + via the KVAR macro, below. Only select pieces of code, like the GC, + are allowed to use KBOARD_INTERNAL_FIELD. */ +#define KBOARD_INTERNAL_FIELD(field) field ## _ + +/* Most code should use this macro to access Lisp fields in struct + kboard. */ +#define KVAR(kboard, field) ((kboard)->KBOARD_INTERNAL_FIELD (field)) + /* Each KBOARD represents one logical input stream from which Emacs gets input. If we are using ordinary terminals, it has one KBOARD object for each terminal device. @@ -70,32 +79,32 @@ can effectively wait for input in the any-kboard state, and hence avoid blocking out the other KBOARDs. See universal-argument in lisp/simple.el for an example. */ - Lisp_Object Voverriding_terminal_local_map; + Lisp_Object KBOARD_INTERNAL_FIELD (Voverriding_terminal_local_map); /* Last command executed by the editor command loop, not counting commands that set the prefix argument. */ - Lisp_Object Vlast_command; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_command); /* Normally same as last-command, but never modified by other commands. */ - Lisp_Object Vreal_last_command; + Lisp_Object KBOARD_INTERNAL_FIELD (Vreal_last_command); /* User-supplied table to translate input characters through. */ - Lisp_Object Vkeyboard_translate_table; + Lisp_Object KBOARD_INTERNAL_FIELD (Vkeyboard_translate_table); /* Last command that may be repeated by `repeat'. */ - Lisp_Object Vlast_repeatable_command; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_repeatable_command); /* The prefix argument for the next command, in raw form. */ - Lisp_Object Vprefix_arg; + Lisp_Object KBOARD_INTERNAL_FIELD (Vprefix_arg); /* Saved prefix argument for the last command, in raw form. */ - Lisp_Object Vlast_prefix_arg; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_prefix_arg); /* Unread events specific to this kboard. */ - Lisp_Object kbd_queue; + Lisp_Object KBOARD_INTERNAL_FIELD (kbd_queue); /* Non-nil while a kbd macro is being defined. */ - Lisp_Object defining_kbd_macro; + Lisp_Object KBOARD_INTERNAL_FIELD (defining_kbd_macro); /* The start of storage for the current keyboard macro. */ Lisp_Object *kbd_macro_buffer; @@ -117,28 +126,28 @@ int kbd_macro_bufsize; /* Last anonymous kbd macro defined. */ - Lisp_Object Vlast_kbd_macro; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro); /* Alist of system-specific X windows key symbols. */ - Lisp_Object Vsystem_key_alist; + Lisp_Object KBOARD_INTERNAL_FIELD (Vsystem_key_alist); /* Cache for modify_event_symbol. */ - Lisp_Object system_key_syms; + Lisp_Object KBOARD_INTERNAL_FIELD (system_key_syms); /* The kind of display: x, w32, ... */ - Lisp_Object Vwindow_system; + Lisp_Object KBOARD_INTERNAL_FIELD (Vwindow_system); /* Keymap mapping keys to alternative preferred forms. See the DEFVAR for more documentation. */ - Lisp_Object Vlocal_function_key_map; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlocal_function_key_map); /* Keymap mapping ASCII function key sequences onto their preferred forms. Initialized by the terminal-specific lisp files. See the DEFVAR for more documentation. */ - Lisp_Object Vinput_decode_map; + Lisp_Object KBOARD_INTERNAL_FIELD (Vinput_decode_map); /* Minibufferless frames on this display use this frame's minibuffer. */ - Lisp_Object Vdefault_minibuffer_frame; + Lisp_Object KBOARD_INTERNAL_FIELD (Vdefault_minibuffer_frame); /* Number of displays using this KBOARD. Normally 1, but can be larger when you have multiple screens on a single X display. */ @@ -146,7 +155,7 @@ /* The text we're echoing in the modeline - partial key sequences, usually. This is nil when not echoing. */ - Lisp_Object echo_string; + Lisp_Object KBOARD_INTERNAL_FIELD (echo_string); /* This flag indicates that events were put into kbd_queue while Emacs was running for some other KBOARD. === modified file 'src/keymap.c' --- src/keymap.c 2011-02-16 15:02:50 +0000 +++ src/keymap.c 2011-02-16 16:35:16 +0000 @@ -1565,8 +1565,8 @@ if (!NILP (olp)) { - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps); + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps); /* The doc said that overriding-terminal-local-map should override overriding-local-map. The code used them both, but it seems clearer to use just one. rms, jan 2005. */ @@ -1745,9 +1745,9 @@ } } - if (! NILP (current_kboard->Voverriding_terminal_local_map)) + if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) { - value = Flookup_key (current_kboard->Voverriding_terminal_local_map, + value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map), key, accept_default); if (! NILP (value) && !INTEGERP (value)) goto done; @@ -2941,11 +2941,11 @@ outbuf = Fcurrent_buffer (); /* Report on alternates for keys. */ - if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix)) + if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix)) { int c; - const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table); - int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table); + const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); + int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)); for (c = 0; c < translate_len; c++) if (translate[c] != c) @@ -2968,7 +2968,7 @@ insert ("\n", 1); /* Insert calls signal_after_change which may GC. */ - translate = SDATA (current_kboard->Vkeyboard_translate_table); + translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); } insert ("\n", 1); @@ -2981,8 +2981,8 @@ /* Print the (major mode) local map. */ start1 = Qnil; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - start1 = current_kboard->Voverriding_terminal_local_map; + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + start1 = KVAR (current_kboard, Voverriding_terminal_local_map); else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; @@ -3064,13 +3064,13 @@ "\f\nGlobal Bindings", nomenu, 0, 1, 0); /* Print the function-key-map translations under this prefix. */ - if (!NILP (current_kboard->Vlocal_function_key_map)) - describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix, + if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) + describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix, "\f\nFunction key map translations", nomenu, 1, 0, 0); /* Print the input-decode-map translations under this prefix. */ - if (!NILP (current_kboard->Vinput_decode_map)) - describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix, + if (!NILP (KVAR (current_kboard, Vinput_decode_map))) + describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix, "\f\nInput decoding map translations", nomenu, 1, 0, 0); UNGCPRO; === modified file 'src/lisp.h' --- src/lisp.h 2011-02-16 15:20:08 +0000 +++ src/lisp.h 2011-02-16 16:35:16 +0000 @@ -1890,7 +1890,7 @@ static struct Lisp_Kboard_Objfwd ko_fwd; \ defvar_kboard (&ko_fwd, \ lname, \ - (int)((char *)(¤t_kboard->vname) \ + (int)((char *)(¤t_kboard->vname ## _) \ - (char *)current_kboard)); \ } while (0) === modified file 'src/macros.c' --- src/macros.c 2011-01-25 04:08:28 +0000 +++ src/macros.c 2011-02-16 16:35:16 +0000 @@ -56,7 +56,7 @@ macro before appending to it. */) (Lisp_Object append, Lisp_Object no_exec) { - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) error ("Already defining kbd macro"); if (!current_kboard->kbd_macro_buffer) @@ -85,9 +85,9 @@ int cvt; /* Check the type of last-kbd-macro in case Lisp code changed it. */ - CHECK_VECTOR_OR_STRING (current_kboard->Vlast_kbd_macro); + CHECK_VECTOR_OR_STRING (KVAR (current_kboard, Vlast_kbd_macro)); - len = XINT (Flength (current_kboard->Vlast_kbd_macro)); + len = XINT (Flength (KVAR (current_kboard, Vlast_kbd_macro))); /* Copy last-kbd-macro into the buffer, in case the Lisp code has put another macro there. */ @@ -100,11 +100,11 @@ } /* Must convert meta modifier when copying string to vector. */ - cvt = STRINGP (current_kboard->Vlast_kbd_macro); + cvt = STRINGP (KVAR (current_kboard, Vlast_kbd_macro)); for (i = 0; i < len; i++) { Lisp_Object c; - c = Faref (current_kboard->Vlast_kbd_macro, make_number (i)); + c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_number (i)); if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80)) XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); current_kboard->kbd_macro_buffer[i] = c; @@ -116,12 +116,12 @@ /* Re-execute the macro we are appending to, for consistency of behavior. */ if (NILP (no_exec)) - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), make_number (1), Qnil); message ("Appending to kbd macro..."); } - current_kboard->defining_kbd_macro = Qt; + KVAR (current_kboard, defining_kbd_macro) = Qt; return Qnil; } @@ -131,9 +131,9 @@ void end_kbd_macro (void) { - current_kboard->defining_kbd_macro = Qnil; + KVAR (current_kboard, defining_kbd_macro) = Qnil; update_mode_lines++; - current_kboard->Vlast_kbd_macro + KVAR (current_kboard, Vlast_kbd_macro) = make_event_array ((current_kboard->kbd_macro_end - current_kboard->kbd_macro_buffer), current_kboard->kbd_macro_buffer); @@ -154,7 +154,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) (Lisp_Object repeat, Lisp_Object loopfunc) { - if (NILP (current_kboard->defining_kbd_macro)) + if (NILP (KVAR (current_kboard, defining_kbd_macro))) error ("Not defining kbd macro"); if (NILP (repeat)) @@ -162,19 +162,19 @@ else CHECK_NUMBER (repeat); - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) { end_kbd_macro (); message ("Keyboard macro defined"); } if (XFASTINT (repeat) == 0) - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc); + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); else { XSETINT (repeat, XINT (repeat)-1); if (XINT (repeat) > 0) - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc); + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); } return Qnil; } @@ -186,7 +186,7 @@ { struct kboard *kb = current_kboard; - if (!NILP (kb->defining_kbd_macro)) + if (!NILP (KVAR (kb, defining_kbd_macro))) { if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize) { @@ -248,21 +248,21 @@ { /* Don't interfere with recognition of the previous command from before this macro started. */ - Vthis_command = current_kboard->Vlast_command; + Vthis_command = KVAR (current_kboard, Vlast_command); /* C-x z after the macro should repeat the macro. */ - real_this_command = current_kboard->Vlast_kbd_macro; + real_this_command = KVAR (current_kboard, Vlast_kbd_macro); - if (! NILP (current_kboard->defining_kbd_macro)) + if (! NILP (KVAR (current_kboard, defining_kbd_macro))) error ("Can't execute anonymous macro while defining one"); - else if (NILP (current_kboard->Vlast_kbd_macro)) + else if (NILP (KVAR (current_kboard, Vlast_kbd_macro))) error ("No kbd macro has been defined"); else - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix, loopfunc); + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), prefix, loopfunc); /* command_loop_1 sets this to nil before it returns; get back the last command within the macro so that it can be last, again, after we return. */ - Vthis_command = current_kboard->Vlast_command; + Vthis_command = KVAR (current_kboard, Vlast_command); return Qnil; } @@ -322,7 +322,7 @@ executing_kbd_macro = final; executing_kbd_macro_index = 0; - current_kboard->Vprefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; if (!NILP (loopfunc)) { === modified file 'src/term.c' --- src/term.c 2011-01-25 04:08:28 +0000 +++ src/term.c 2011-02-16 16:35:16 +0000 @@ -1350,14 +1350,14 @@ KBOARD *kboard = term_get_fkeys_kboard; /* This can happen if CANNOT_DUMP or with strange options. */ - if (!KEYMAPP (kboard->Vinput_decode_map)) - kboard->Vinput_decode_map = Fmake_sparse_keymap (Qnil); + if (!KEYMAPP (KVAR (kboard, Vinput_decode_map))) + KVAR (kboard, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++) { char *sequence = tgetstr (keys[i].cap, address); if (sequence) - Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), Fmake_vector (make_number (1), intern (keys[i].name))); } @@ -1377,13 +1377,13 @@ if (k0) /* Define f0 first, so that f10 takes precedence in case the key sequences happens to be the same. */ - Fdefine_key (kboard->Vinput_decode_map, build_string (k0), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), Fmake_vector (make_number (1), intern ("f0"))); - Fdefine_key (kboard->Vinput_decode_map, build_string (k_semi), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), Fmake_vector (make_number (1), intern ("f10"))); } else if (k0) - Fdefine_key (kboard->Vinput_decode_map, build_string (k0), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), Fmake_vector (make_number (1), intern (k0_name))); } @@ -1406,7 +1406,7 @@ if (sequence) { sprintf (fkey, "f%d", i); - Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), Fmake_vector (make_number (1), intern (fkey))); } @@ -1423,7 +1423,7 @@ { \ char *sequence = tgetstr (cap2, address); \ if (sequence) \ - Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), \ + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \ Fmake_vector (make_number (1), \ intern (sym))); \ } @@ -3418,7 +3418,7 @@ terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = Qnil; + KVAR (terminal->kboard, Vwindow_system) = Qnil; terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; terminal->kboard->reference_count++; === modified file 'src/window.c' --- src/window.c 2011-02-16 15:02:50 +0000 +++ src/window.c 2011-02-16 16:35:16 +0000 @@ -4834,8 +4834,8 @@ possibility of point becoming "stuck" on a tall line when scrolling by one line. */ if (window_scroll_pixel_based_preserve_y < 0 - || !SYMBOLP (current_kboard->Vlast_command) - || NILP (Fget (current_kboard->Vlast_command, Qscroll_command))) + || !SYMBOLP (KVAR (current_kboard, Vlast_command)) + || NILP (Fget (KVAR (current_kboard, Vlast_command), Qscroll_command))) { start_display (&it, w, start); move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); @@ -5091,8 +5091,8 @@ if (!NILP (Vscroll_preserve_screen_position)) { if (window_scroll_preserve_vpos <= 0 - || !SYMBOLP (current_kboard->Vlast_command) - || NILP (Fget (current_kboard->Vlast_command, Qscroll_command))) + || !SYMBOLP (KVAR (current_kboard, Vlast_command)) + || NILP (Fget (KVAR (current_kboard, Vlast_command), Qscroll_command))) { struct position posit = *compute_motion (startpos, 0, 0, 0, === modified file 'src/xfns.c' --- src/xfns.c 2011-02-16 15:02:50 +0000 +++ src/xfns.c 2011-02-16 16:35:16 +0000 @@ -3473,9 +3473,9 @@ /* Initialize `default-minibuffer-frame' in case this is the first frame on this terminal. */ if (FRAME_HAS_MINIBUF_P (f) - && (!FRAMEP (kb->Vdefault_minibuffer_frame) - || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) - kb->Vdefault_minibuffer_frame = frame; + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + KVAR (kb, Vdefault_minibuffer_frame) = frame; /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ === modified file 'src/xterm.c' --- src/xterm.c 2011-02-11 15:40:19 +0000 +++ src/xterm.c 2011-02-16 16:35:16 +0000 @@ -7727,7 +7727,7 @@ { /* Set this to t so that delete_frame won't get confused trying to find a replacement. */ - FRAME_KBOARD (XFRAME (frame))->Vdefault_minibuffer_frame = Qt; + KVAR (FRAME_KBOARD (XFRAME (frame)), Vdefault_minibuffer_frame) = Qt; delete_frame (frame, Qnoelisp); } @@ -9966,7 +9966,7 @@ { terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = Qx; + KVAR (terminal->kboard, Vwindow_system) = Qx; /* Add the keyboard to the list before running Lisp code (via Qvendor_specific_keysyms below), since these are not traced @@ -9988,7 +9988,7 @@ /* Temporarily hide the partially initialized terminal. */ terminal_list = terminal->next_terminal; UNBLOCK_INPUT; - terminal->kboard->Vsystem_key_alist + KVAR (terminal->kboard, Vsystem_key_alist) = call1 (Qvendor_specific_keysyms, vendor ? build_string (vendor) : empty_unibyte_string); BLOCK_INPUT; ------------------------------------------------------------ revno: 103293 committer: Tom Tromey branch nick: trunk timestamp: Wed 2011-02-16 08:20:08 -0700 message: * lisp.h (DEFVAR_BUFFER_DEFAULTS): Use BVAR. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 15:02:50 +0000 +++ src/ChangeLog 2011-02-16 15:20:08 +0000 @@ -1,3 +1,7 @@ +2011-02-16 Tom Tromey + + * lisp.h (DEFVAR_BUFFER_DEFAULTS): Use BVAR. + 2011-02-16 Tom Tromey * xfns.c (x_create_tip_frame, Fx_show_tip): Replace B_ with BVAR. === modified file 'src/lisp.h' --- src/lisp.h 2011-02-16 15:02:50 +0000 +++ src/lisp.h 2011-02-16 15:20:08 +0000 @@ -1882,7 +1882,7 @@ #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \ do { \ static struct Lisp_Objfwd o_fwd; \ - defvar_lisp_nopro (&o_fwd, lname, &buffer_defaults.vname ## _); \ + defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \ } while (0) #define DEFVAR_KBOARD(lname, vname, doc) \ ------------------------------------------------------------ revno: 103292 committer: Tom Tromey branch nick: trunk timestamp: Wed 2011-02-16 08:02:50 -0700 message: Change B_ to BVAR * xfns.c (x_create_tip_frame, Fx_show_tip): Replace B_ with BVAR. * xfaces.c (compute_char_face): Replace B_ with BVAR. * xdisp.c (pos_visible_p, init_iterator, reseat_1) (message_dolog, update_echo_area, ensure_echo_area_buffers) (with_echo_area_buffer, setup_echo_area_for_printing) (set_message_1, update_menu_bar, update_tool_bar) (text_outside_line_unchanged_p, redisplay_internal) (try_scrolling, try_cursor_movement, redisplay_window) (try_window_reusing_current_matrix, row_containing_pos) (try_window_id, get_overlay_arrow_glyph_row, display_line) (Fcurrent_bidi_paragraph_direction, display_mode_lines) (decode_mode_spec_coding, decode_mode_spec, display_count_lines) (get_window_cursor_type, note_mouse_highlight): Replace B_ with BVAR. * window.c (window_display_table, unshow_buffer, window_loop) (window_min_size_2, set_window_buffer, Fset_window_buffer) (select_window, Fforce_window_update, temp_output_buffer_show) (Fset_window_configuration, save_window_save): Replace B_ with BVAR. * w32fns.c (x_create_tip_frame, Fx_show_tip, Fw32_shell_execute): Replace B_ with BVAR. * undo.c (record_point, record_insert, record_delete) (record_marker_adjustment, record_first_change) (record_property_change, Fundo_boundary, truncate_undo_list) (Fprimitive_undo): Replace B_ with BVAR. * syntax.h (Vstandard_syntax_table, CURRENT_SYNTAX_TABLE) (SETUP_BUFFER_SYNTAX_TABLE): Replace B_ with BVAR. * syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table) (Fset_syntax_table, Fmodify_syntax_entry, skip_chars) (skip_syntaxes, scan_lists): Replace B_ with BVAR. * search.c (compile_pattern_1, compile_pattern, looking_at_1) (string_match_1, fast_looking_at, newline_cache_on_off) (search_command, search_buffer, simple_search, boyer_moore) (Freplace_match): Replace B_ with BVAR. * process.c (get_process, list_processes_1, Fstart_process) (Fmake_serial_process, Fmake_network_process) (read_process_output, send_process, exec_sentinel) (status_notify, setup_process_coding_systems): Replace B_ with BVAR. * print.c (PRINTDECLARE, PRINTPREPARE, PRINTFINISH, printchar) (strout, print_string, temp_output_buffer_setup, print_object): Replace B_ with BVAR. * msdos.c (IT_frame_up_to_date): Replace B_ with BVAR. * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Replace B_ with BVAR. * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) (set_marker_both, set_marker_restricted_both, unchain_marker): Replace B_ with BVAR. * lread.c (readchar, unreadchar, openp, readevalloop) (Feval_buffer, Feval_region): Replace B_ with BVAR. * lisp.h (DOWNCASE_TABLE, UPCASE_TABLE): Replace B_ with BVAR. * keymap.c (Flocal_key_binding, Fuse_local_map) (Fcurrent_local_map, push_key_description) (Fdescribe_buffer_bindings): Replace B_ with BVAR. * keyboard.c (command_loop_1, read_char_minibuf_menu_prompt) (read_key_sequence): Replace B_ with BVAR. * intervals.h (TEXT_PROP_MEANS_INVISIBLE): Replace B_ with BVAR. * intervals.c (set_point_both, get_local_map): Replace B_ with BVAR. * insdel.c (check_markers, insert_char, insert_1_both) (insert_from_string_1, insert_from_gap, insert_from_buffer_1) (adjust_after_replace, replace_range, del_range_2) (modify_region, prepare_to_modify_buffer) (Fcombine_after_change_execute): Replace B_ with BVAR. * indent.c (buffer_display_table, recompute_width_table) (width_run_cache_on_off, current_column, scan_for_column) (Findent_to, position_indentation, compute_motion, vmotion): Replace B_ with BVAR. * fringe.c (get_logical_cursor_bitmap) (get_logical_fringe_bitmap, update_window_fringes): Replace B_ with BVAR. * frame.c (make_frame_visible_1): Replace B_ with BVAR. * font.c (font_at): Replace B_ with BVAR. * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): Replace B_ with BVAR. * filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer) (unlock_buffer): Replace B_ with BVAR. * fileio.c (Fexpand_file_name, Ffile_directory_p) (Ffile_regular_p, Ffile_selinux_context) (Fset_file_selinux_context, Ffile_modes, Fset_file_modes) (Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind) (Finsert_file_contents, choose_write_coding_system) (Fwrite_region, build_annotations, Fverify_visited_file_modtime) (Fset_visited_file_modtime, auto_save_error, auto_save_1) (Fdo_auto_save, Fset_buffer_auto_saved): Replace B_ with BVAR. * editfns.c (region_limit, Fmark_marker, save_excursion_save) (save_excursion_restore, Fprevious_char, Fchar_before) (general_insert_function, Finsert_char, Finsert_byte) (make_buffer_string_both, Finsert_buffer_substring) (Fcompare_buffer_substrings, subst_char_in_region_unwind) (subst_char_in_region_unwind_1, Fsubst_char_in_region) (Ftranslate_region_internal, save_restriction_restore) (Fchar_equal): Replace B_ with BVAR. * dispnew.c (Fframe_or_buffer_changed_p): Replace B_ with BVAR. * dispextern.h (WINDOW_WANTS_MODELINE_P) (WINDOW_WANTS_HEADER_LINE_P): Replace B_ with BVAR. * dired.c (directory_files_internal): Replace B_ with BVAR. * data.c (swap_in_symval_forwarding, set_internal) (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p): Replace B_ with BVAR. * composite.c (fill_gstring_header) (composition_compute_stop_pos, composition_adjust_point) (Ffind_composition_internal): Replace B_ with BVAR. * coding.c (decode_coding, encode_coding) (make_conversion_work_buffer, decode_coding_gap) (decode_coding_object, encode_coding_object) (Fdetect_coding_region, Ffind_coding_systems_region_internal) (Funencodable_char_position, Fcheck_coding_systems_region): Replace B_ with BVAR. * cmds.c (Fself_insert_command, internal_self_insert): Replace B_ with BVAR. * charset.c (Ffind_charset_region): Replace B_ with BVAR. * character.h (FETCH_CHAR_ADVANCE, INC_BOTH, DEC_BOTH) (ASCII_CHAR_WIDTH): Replace B_ with BVAR. * character.c (chars_in_text, Fget_byte): Replace B_ with BVAR. * category.h (Vstandard_category_table): Replace B_ with BVAR. * category.c (check_category_table, Fcategory_table) (Fset_category_table, char_category_set): Replace B_ with BVAR. * casetab.c (Fcurrent_case_table, set_case_table): Replace B_ with BVAR. * casefiddle.c (casify_object, casify_region): Replace B_ with BVAR. * callproc.c (Fcall_process, Fcall_process_region): Replace B_ with BVAR. * callint.c (check_mark, Fcall_interactively): Replace B_ with BVAR. * bytecode.c (Fbyte_code): Replace B_ with BVAR. * buffer.h (FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE, BVAR): Replace B_ with BVAR. * buffer.c (Fbuffer_live_p, Fget_file_buffer) (get_truename_buffer, Fget_buffer_create) (clone_per_buffer_values, Fmake_indirect_buffer, reset_buffer) (reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name) (Fbuffer_local_value, buffer_lisp_local_variables) (Fset_buffer_modified_p, Frestore_buffer_modified_p) (Frename_buffer, Fother_buffer, Fbuffer_enable_undo) (Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1) (set_buffer_temp, Fset_buffer, set_buffer_if_live) (Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer) (Fbuffer_swap_text, swapfield_, Fbuffer_swap_text) (Fset_buffer_multibyte, swap_out_buffer_local_variables) (record_overlay_string, overlay_strings, init_buffer_once) (init_buffer, syms_of_buffer): Replace B_ with BVAR. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 08:39:19 +0000 +++ src/ChangeLog 2011-02-16 15:02:50 +0000 @@ -1,3 +1,149 @@ +2011-02-16 Tom Tromey + + * xfns.c (x_create_tip_frame, Fx_show_tip): Replace B_ with BVAR. + * xfaces.c (compute_char_face): Replace B_ with BVAR. + * xdisp.c (pos_visible_p, init_iterator, reseat_1) + (message_dolog, update_echo_area, ensure_echo_area_buffers) + (with_echo_area_buffer, setup_echo_area_for_printing) + (set_message_1, update_menu_bar, update_tool_bar) + (text_outside_line_unchanged_p, redisplay_internal) + (try_scrolling, try_cursor_movement, redisplay_window) + (try_window_reusing_current_matrix, row_containing_pos) + (try_window_id, get_overlay_arrow_glyph_row, display_line) + (Fcurrent_bidi_paragraph_direction, display_mode_lines) + (decode_mode_spec_coding, decode_mode_spec, display_count_lines) + (get_window_cursor_type, note_mouse_highlight): Replace B_ with + BVAR. + * window.c (window_display_table, unshow_buffer, window_loop) + (window_min_size_2, set_window_buffer, Fset_window_buffer) + (select_window, Fforce_window_update, temp_output_buffer_show) + (Fset_window_configuration, save_window_save): Replace B_ with + BVAR. + * w32fns.c (x_create_tip_frame, Fx_show_tip, Fw32_shell_execute): + Replace B_ with BVAR. + * undo.c (record_point, record_insert, record_delete) + (record_marker_adjustment, record_first_change) + (record_property_change, Fundo_boundary, truncate_undo_list) + (Fprimitive_undo): Replace B_ with BVAR. + * syntax.h (Vstandard_syntax_table, CURRENT_SYNTAX_TABLE) + (SETUP_BUFFER_SYNTAX_TABLE): Replace B_ with BVAR. + * syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table) + (Fset_syntax_table, Fmodify_syntax_entry, skip_chars) + (skip_syntaxes, scan_lists): Replace B_ with BVAR. + * search.c (compile_pattern_1, compile_pattern, looking_at_1) + (string_match_1, fast_looking_at, newline_cache_on_off) + (search_command, search_buffer, simple_search, boyer_moore) + (Freplace_match): Replace B_ with BVAR. + * process.c (get_process, list_processes_1, Fstart_process) + (Fmake_serial_process, Fmake_network_process) + (read_process_output, send_process, exec_sentinel) + (status_notify, setup_process_coding_systems): Replace B_ with + BVAR. + * print.c (PRINTDECLARE, PRINTPREPARE, PRINTFINISH, printchar) + (strout, print_string, temp_output_buffer_setup, print_object): + Replace B_ with BVAR. + * msdos.c (IT_frame_up_to_date): Replace B_ with BVAR. + * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Replace + B_ with BVAR. + * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) + (set_marker_both, set_marker_restricted_both, unchain_marker): + Replace B_ with BVAR. + * lread.c (readchar, unreadchar, openp, readevalloop) + (Feval_buffer, Feval_region): Replace B_ with BVAR. + * lisp.h (DOWNCASE_TABLE, UPCASE_TABLE): Replace B_ with BVAR. + * keymap.c (Flocal_key_binding, Fuse_local_map) + (Fcurrent_local_map, push_key_description) + (Fdescribe_buffer_bindings): Replace B_ with BVAR. + * keyboard.c (command_loop_1, read_char_minibuf_menu_prompt) + (read_key_sequence): Replace B_ with BVAR. + * intervals.h (TEXT_PROP_MEANS_INVISIBLE): Replace B_ with BVAR. + * intervals.c (set_point_both, get_local_map): Replace B_ with + BVAR. + * insdel.c (check_markers, insert_char, insert_1_both) + (insert_from_string_1, insert_from_gap, insert_from_buffer_1) + (adjust_after_replace, replace_range, del_range_2) + (modify_region, prepare_to_modify_buffer) + (Fcombine_after_change_execute): Replace B_ with BVAR. + * indent.c (buffer_display_table, recompute_width_table) + (width_run_cache_on_off, current_column, scan_for_column) + (Findent_to, position_indentation, compute_motion, vmotion): + Replace B_ with BVAR. + * fringe.c (get_logical_cursor_bitmap) + (get_logical_fringe_bitmap, update_window_fringes): Replace B_ + with BVAR. + * frame.c (make_frame_visible_1): Replace B_ with BVAR. + * font.c (font_at): Replace B_ with BVAR. + * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): + Replace B_ with BVAR. + * filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer) + (unlock_buffer): Replace B_ with BVAR. + * fileio.c (Fexpand_file_name, Ffile_directory_p) + (Ffile_regular_p, Ffile_selinux_context) + (Fset_file_selinux_context, Ffile_modes, Fset_file_modes) + (Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind) + (Finsert_file_contents, choose_write_coding_system) + (Fwrite_region, build_annotations, Fverify_visited_file_modtime) + (Fset_visited_file_modtime, auto_save_error, auto_save_1) + (Fdo_auto_save, Fset_buffer_auto_saved): Replace B_ with BVAR. + * editfns.c (region_limit, Fmark_marker, save_excursion_save) + (save_excursion_restore, Fprevious_char, Fchar_before) + (general_insert_function, Finsert_char, Finsert_byte) + (make_buffer_string_both, Finsert_buffer_substring) + (Fcompare_buffer_substrings, subst_char_in_region_unwind) + (subst_char_in_region_unwind_1, Fsubst_char_in_region) + (Ftranslate_region_internal, save_restriction_restore) + (Fchar_equal): Replace B_ with BVAR. + * dispnew.c (Fframe_or_buffer_changed_p): Replace B_ with BVAR. + * dispextern.h (WINDOW_WANTS_MODELINE_P) + (WINDOW_WANTS_HEADER_LINE_P): Replace B_ with BVAR. + * dired.c (directory_files_internal): Replace B_ with BVAR. + * data.c (swap_in_symval_forwarding, set_internal) + (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p): + Replace B_ with BVAR. + * composite.c (fill_gstring_header) + (composition_compute_stop_pos, composition_adjust_point) + (Ffind_composition_internal): Replace B_ with BVAR. + * coding.c (decode_coding, encode_coding) + (make_conversion_work_buffer, decode_coding_gap) + (decode_coding_object, encode_coding_object) + (Fdetect_coding_region, Ffind_coding_systems_region_internal) + (Funencodable_char_position, Fcheck_coding_systems_region): + Replace B_ with BVAR. + * cmds.c (Fself_insert_command, internal_self_insert): Replace B_ + with BVAR. + * charset.c (Ffind_charset_region): Replace B_ with BVAR. + * character.h (FETCH_CHAR_ADVANCE, INC_BOTH, DEC_BOTH) + (ASCII_CHAR_WIDTH): Replace B_ with BVAR. + * character.c (chars_in_text, Fget_byte): Replace B_ with BVAR. + * category.h (Vstandard_category_table): Replace B_ with BVAR. + * category.c (check_category_table, Fcategory_table) + (Fset_category_table, char_category_set): Replace B_ with BVAR. + * casetab.c (Fcurrent_case_table, set_case_table): Replace B_ with + BVAR. + * casefiddle.c (casify_object, casify_region): Replace B_ with + BVAR. + * callproc.c (Fcall_process, Fcall_process_region): Replace B_ + with BVAR. + * callint.c (check_mark, Fcall_interactively): Replace B_ with + BVAR. + * bytecode.c (Fbyte_code): Replace B_ with BVAR. + * buffer.h (FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE, BVAR): Replace B_ + with BVAR. + * buffer.c (Fbuffer_live_p, Fget_file_buffer) + (get_truename_buffer, Fget_buffer_create) + (clone_per_buffer_values, Fmake_indirect_buffer, reset_buffer) + (reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name) + (Fbuffer_local_value, buffer_lisp_local_variables) + (Fset_buffer_modified_p, Frestore_buffer_modified_p) + (Frename_buffer, Fother_buffer, Fbuffer_enable_undo) + (Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1) + (set_buffer_temp, Fset_buffer, set_buffer_if_live) + (Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer) + (Fbuffer_swap_text, swapfield_, Fbuffer_swap_text) + (Fset_buffer_multibyte, swap_out_buffer_local_variables) + (record_overlay_string, overlay_strings, init_buffer_once) + (init_buffer, syms_of_buffer): Replace B_ with BVAR. + 2011-02-16 Eli Zaretskii * xdisp.c (redisplay_internal): Resynchronize `w' if the selected === modified file 'src/buffer.c' --- src/buffer.c 2011-02-14 17:35:21 +0000 +++ src/buffer.c 2011-02-16 15:02:50 +0000 @@ -162,7 +162,7 @@ Value is nil if OBJECT is not a buffer or if it has been killed. */) (Lisp_Object object) { - return ((BUFFERP (object) && ! NILP (B_ (XBUFFER (object), name))) + return ((BUFFERP (object) && ! NILP (BVAR (XBUFFER (object), name))) ? Qt : Qnil); } @@ -266,8 +266,8 @@ { buf = Fcdr (XCAR (tail)); if (!BUFFERP (buf)) continue; - if (!STRINGP (B_ (XBUFFER (buf), filename))) continue; - tem = Fstring_equal (B_ (XBUFFER (buf), filename), filename); + if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue; + tem = Fstring_equal (BVAR (XBUFFER (buf), filename), filename); if (!NILP (tem)) return buf; } @@ -283,8 +283,8 @@ { buf = Fcdr (XCAR (tail)); if (!BUFFERP (buf)) continue; - if (!STRINGP (B_ (XBUFFER (buf), file_truename))) continue; - tem = Fstring_equal (B_ (XBUFFER (buf), file_truename), filename); + if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue; + tem = Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename); if (!NILP (tem)) return buf; } @@ -353,7 +353,7 @@ b->newline_cache = 0; b->width_run_cache = 0; - B_ (b, width_table) = Qnil; + BVAR (b, width_table) = Qnil; b->prevent_redisplay_optimizations_p = 1; /* Put this on the chain of all buffers including killed ones. */ @@ -362,22 +362,22 @@ /* An ordinary buffer normally doesn't need markers to handle BEGV and ZV. */ - B_ (b, pt_marker) = Qnil; - B_ (b, begv_marker) = Qnil; - B_ (b, zv_marker) = Qnil; + BVAR (b, pt_marker) = Qnil; + BVAR (b, begv_marker) = Qnil; + BVAR (b, zv_marker) = Qnil; name = Fcopy_sequence (buffer_or_name); STRING_SET_INTERVALS (name, NULL_INTERVAL); - B_ (b, name) = name; + BVAR (b, name) = name; - B_ (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; + BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; reset_buffer (b); reset_buffer_local_variables (b, 1); - B_ (b, mark) = Fmake_marker (); + BVAR (b, mark) = Fmake_marker (); BUF_MARKERS (b) = NULL; - B_ (b, name) = name; + BVAR (b, name) = name; /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); @@ -486,7 +486,7 @@ /* Get (a copy of) the alist of Lisp-level local variables of FROM and install that in TO. */ - B_ (to, local_var_alist) = buffer_lisp_local_variables (from); + BVAR (to, local_var_alist) = buffer_lisp_local_variables (from); } DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, @@ -512,7 +512,7 @@ base_buffer = Fget_buffer (base_buffer); if (NILP (base_buffer)) error ("No such buffer: `%s'", SDATA (tem)); - if (NILP (B_ (XBUFFER (base_buffer), name))) + if (NILP (BVAR (XBUFFER (base_buffer), name))) error ("Base buffer has been killed"); if (SCHARS (name) == 0) @@ -536,7 +536,7 @@ b->newline_cache = 0; b->width_run_cache = 0; - B_ (b, width_table) = Qnil; + BVAR (b, width_table) = Qnil; /* Put this on the chain of all buffers including killed ones. */ b->next = all_buffers; @@ -544,7 +544,7 @@ name = Fcopy_sequence (name); STRING_SET_INTERVALS (name, NULL_INTERVAL); - B_ (b, name) = name; + BVAR (b, name) = name; reset_buffer (b); reset_buffer_local_variables (b, 1); @@ -553,57 +553,57 @@ XSETBUFFER (buf, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); - B_ (b, mark) = Fmake_marker (); - B_ (b, name) = name; + BVAR (b, mark) = Fmake_marker (); + BVAR (b, name) = name; /* The multibyte status belongs to the base buffer. */ - B_ (b, enable_multibyte_characters) = B_ (b->base_buffer, enable_multibyte_characters); + BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters); /* Make sure the base buffer has markers for its narrowing. */ - if (NILP (B_ (b->base_buffer, pt_marker))) + if (NILP (BVAR (b->base_buffer, pt_marker))) { - B_ (b->base_buffer, pt_marker) = Fmake_marker (); - set_marker_both (B_ (b->base_buffer, pt_marker), base_buffer, + BVAR (b->base_buffer, pt_marker) = Fmake_marker (); + set_marker_both (BVAR (b->base_buffer, pt_marker), base_buffer, BUF_PT (b->base_buffer), BUF_PT_BYTE (b->base_buffer)); } - if (NILP (B_ (b->base_buffer, begv_marker))) + if (NILP (BVAR (b->base_buffer, begv_marker))) { - B_ (b->base_buffer, begv_marker) = Fmake_marker (); - set_marker_both (B_ (b->base_buffer, begv_marker), base_buffer, + BVAR (b->base_buffer, begv_marker) = Fmake_marker (); + set_marker_both (BVAR (b->base_buffer, begv_marker), base_buffer, BUF_BEGV (b->base_buffer), BUF_BEGV_BYTE (b->base_buffer)); } - if (NILP (B_ (b->base_buffer, zv_marker))) + if (NILP (BVAR (b->base_buffer, zv_marker))) { - B_ (b->base_buffer, zv_marker) = Fmake_marker (); - set_marker_both (B_ (b->base_buffer, zv_marker), base_buffer, + BVAR (b->base_buffer, zv_marker) = Fmake_marker (); + set_marker_both (BVAR (b->base_buffer, zv_marker), base_buffer, BUF_ZV (b->base_buffer), BUF_ZV_BYTE (b->base_buffer)); - XMARKER (B_ (b->base_buffer, zv_marker))->insertion_type = 1; + XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1; } if (NILP (clone)) { /* Give the indirect buffer markers for its narrowing. */ - B_ (b, pt_marker) = Fmake_marker (); - set_marker_both (B_ (b, pt_marker), buf, BUF_PT (b), BUF_PT_BYTE (b)); - B_ (b, begv_marker) = Fmake_marker (); - set_marker_both (B_ (b, begv_marker), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); - B_ (b, zv_marker) = Fmake_marker (); - set_marker_both (B_ (b, zv_marker), buf, BUF_ZV (b), BUF_ZV_BYTE (b)); - XMARKER (B_ (b, zv_marker))->insertion_type = 1; + BVAR (b, pt_marker) = Fmake_marker (); + set_marker_both (BVAR (b, pt_marker), buf, BUF_PT (b), BUF_PT_BYTE (b)); + BVAR (b, begv_marker) = Fmake_marker (); + set_marker_both (BVAR (b, begv_marker), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); + BVAR (b, zv_marker) = Fmake_marker (); + set_marker_both (BVAR (b, zv_marker), buf, BUF_ZV (b), BUF_ZV_BYTE (b)); + XMARKER (BVAR (b, zv_marker))->insertion_type = 1; } else { struct buffer *old_b = current_buffer; clone_per_buffer_values (b->base_buffer, b); - B_ (b, filename) = Qnil; - B_ (b, file_truename) = Qnil; - B_ (b, display_count) = make_number (0); - B_ (b, backed_up) = Qnil; - B_ (b, auto_save_file_name) = Qnil; + BVAR (b, filename) = Qnil; + BVAR (b, file_truename) = Qnil; + BVAR (b, display_count) = make_number (0); + BVAR (b, backed_up) = Qnil; + BVAR (b, auto_save_file_name) = Qnil; set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); Fset (intern ("buffer-file-number"), Qnil); @@ -647,34 +647,34 @@ void reset_buffer (register struct buffer *b) { - B_ (b, filename) = Qnil; - B_ (b, file_truename) = Qnil; - B_ (b, directory) = (current_buffer) ? B_ (current_buffer, directory) : Qnil; + BVAR (b, filename) = Qnil; + BVAR (b, file_truename) = Qnil; + BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil; b->modtime = 0; b->modtime_size = -1; - XSETFASTINT (B_ (b, save_length), 0); + XSETFASTINT (BVAR (b, save_length), 0); b->last_window_start = 1; /* It is more conservative to start out "changed" than "unchanged". */ b->clip_changed = 0; b->prevent_redisplay_optimizations_p = 1; - B_ (b, backed_up) = Qnil; + BVAR (b, backed_up) = Qnil; BUF_AUTOSAVE_MODIFF (b) = 0; b->auto_save_failure_time = -1; - B_ (b, auto_save_file_name) = Qnil; - B_ (b, read_only) = Qnil; + BVAR (b, auto_save_file_name) = Qnil; + BVAR (b, read_only) = Qnil; b->overlays_before = NULL; b->overlays_after = NULL; b->overlay_center = BEG; - B_ (b, mark_active) = Qnil; - B_ (b, point_before_scroll) = Qnil; - B_ (b, file_format) = Qnil; - B_ (b, auto_save_file_format) = Qt; - B_ (b, last_selected_window) = Qnil; - XSETINT (B_ (b, display_count), 0); - B_ (b, display_time) = Qnil; - B_ (b, enable_multibyte_characters) = B_ (&buffer_defaults, enable_multibyte_characters); - B_ (b, cursor_type) = B_ (&buffer_defaults, cursor_type); - B_ (b, extra_line_spacing) = B_ (&buffer_defaults, extra_line_spacing); + BVAR (b, mark_active) = Qnil; + BVAR (b, point_before_scroll) = Qnil; + BVAR (b, file_format) = Qnil; + BVAR (b, auto_save_file_format) = Qt; + BVAR (b, last_selected_window) = Qnil; + XSETINT (BVAR (b, display_count), 0); + BVAR (b, display_time) = Qnil; + BVAR (b, enable_multibyte_characters) = BVAR (&buffer_defaults, enable_multibyte_characters); + BVAR (b, cursor_type) = BVAR (&buffer_defaults, cursor_type); + BVAR (b, extra_line_spacing) = BVAR (&buffer_defaults, extra_line_spacing); b->display_error_modiff = 0; } @@ -698,10 +698,10 @@ things that depend on the major mode. default-major-mode is handled at a higher level. We ignore it here. */ - B_ (b, major_mode) = Qfundamental_mode; - B_ (b, keymap) = Qnil; - B_ (b, mode_name) = QSFundamental; - B_ (b, minor_modes) = Qnil; + BVAR (b, major_mode) = Qfundamental_mode; + BVAR (b, keymap) = Qnil; + BVAR (b, mode_name) = QSFundamental; + BVAR (b, minor_modes) = Qnil; /* If the standard case table has been altered and invalidated, fix up its insides first. */ @@ -710,22 +710,22 @@ && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) Fset_standard_case_table (Vascii_downcase_table); - B_ (b, downcase_table) = Vascii_downcase_table; - B_ (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; - B_ (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; - B_ (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; - B_ (b, invisibility_spec) = Qt; + BVAR (b, downcase_table) = Vascii_downcase_table; + BVAR (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; + BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; + BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; + BVAR (b, invisibility_spec) = Qt; #ifndef DOS_NT - B_ (b, buffer_file_type) = Qnil; + BVAR (b, buffer_file_type) = Qnil; #endif /* Reset all (or most) per-buffer variables to their defaults. */ if (permanent_too) - B_ (b, local_var_alist) = Qnil; + BVAR (b, local_var_alist) = Qnil; else { Lisp_Object tmp, prop, last = Qnil; - for (tmp = B_ (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) + for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) { /* If permanent-local, keep it. */ @@ -755,7 +755,7 @@ } /* Delete this local variable. */ else if (NILP (last)) - B_ (b, local_var_alist) = XCDR (tmp); + BVAR (b, local_var_alist) = XCDR (tmp); else XSETCDR (last, XCDR (tmp)); } @@ -830,9 +830,9 @@ (register Lisp_Object buffer) { if (NILP (buffer)) - return B_ (current_buffer, name); + return BVAR (current_buffer, name); CHECK_BUFFER (buffer); - return B_ (XBUFFER (buffer), name); + return BVAR (XBUFFER (buffer), name); } DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, @@ -841,9 +841,9 @@ (register Lisp_Object buffer) { if (NILP (buffer)) - return B_ (current_buffer, filename); + return BVAR (current_buffer, filename); CHECK_BUFFER (buffer); - return B_ (XBUFFER (buffer), filename); + return BVAR (XBUFFER (buffer), filename); } DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, @@ -895,7 +895,7 @@ { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ - result = Fassoc (variable, B_ (buf, local_var_alist)); + result = Fassoc (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { if (blv->fwd) @@ -944,7 +944,7 @@ { Lisp_Object result = Qnil; register Lisp_Object tail; - for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) { Lisp_Object val, elt; @@ -1043,9 +1043,9 @@ /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ - fn = B_ (current_buffer, file_truename); + fn = BVAR (current_buffer, file_truename); /* Test buffer-file-name so that binding it to nil is effective. */ - if (!NILP (fn) && ! NILP (B_ (current_buffer, filename))) + if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename))) { already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) @@ -1110,9 +1110,9 @@ /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ - fn = B_ (current_buffer, file_truename); + fn = BVAR (current_buffer, file_truename); /* Test buffer-file-name so that binding it to nil is effective. */ - if (!NILP (fn) && ! NILP (B_ (current_buffer, filename))) + if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename))) { int already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) @@ -1199,14 +1199,14 @@ with the original name. It makes UNIQUE equivalent to (rename-buffer (generate-new-buffer-name NEWNAME)). */ if (NILP (unique) && XBUFFER (tem) == current_buffer) - return B_ (current_buffer, name); + return BVAR (current_buffer, name); if (!NILP (unique)) - newname = Fgenerate_new_buffer_name (newname, B_ (current_buffer, name)); + newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name)); else error ("Buffer name `%s' is in use", SDATA (newname)); } - B_ (current_buffer, name) = newname; + BVAR (current_buffer, name) = newname; /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ @@ -1214,11 +1214,11 @@ XSETBUFFER (buf, current_buffer); Fsetcar (Frassq (buf, Vbuffer_alist), newname); - if (NILP (B_ (current_buffer, filename)) - && !NILP (B_ (current_buffer, auto_save_file_name))) + if (NILP (BVAR (current_buffer, filename)) + && !NILP (BVAR (current_buffer, auto_save_file_name))) call0 (intern ("rename-auto-save-file")); /* Refetch since that last call may have done GC. */ - return B_ (current_buffer, name); + return BVAR (current_buffer, name); } DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, @@ -1263,9 +1263,9 @@ continue; if (NILP (buf)) continue; - if (NILP (B_ (XBUFFER (buf), name))) + if (NILP (BVAR (XBUFFER (buf), name))) continue; - if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') + if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') continue; /* If the selected frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ @@ -1313,8 +1313,8 @@ nsberror (buffer); } - if (EQ (B_ (XBUFFER (real_buffer), undo_list), Qt)) - B_ (XBUFFER (real_buffer), undo_list) = Qnil; + if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt)) + BVAR (XBUFFER (real_buffer), undo_list) = Qnil; return Qnil; } @@ -1359,16 +1359,16 @@ b = XBUFFER (buffer); /* Avoid trouble for buffer already dead. */ - if (NILP (B_ (b, name))) + if (NILP (BVAR (b, name))) return Qnil; /* Query if the buffer is still modified. */ - if (INTERACTIVE && !NILP (B_ (b, filename)) + if (INTERACTIVE && !NILP (BVAR (b, filename)) && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) { GCPRO1 (buffer); tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ", - B_ (b, name), make_number (0))); + BVAR (b, name), make_number (0))); UNGCPRO; if (NILP (tem)) return Qnil; @@ -1402,7 +1402,7 @@ if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) return Qnil; - if (NILP (B_ (b, name))) + if (NILP (BVAR (b, name))) return Qnil; /* When we kill a base buffer, kill all its indirect buffers. @@ -1417,7 +1417,7 @@ for (other = all_buffers; other; other = other->next) /* all_buffers contains dead buffers too; don't re-kill them. */ - if (other->base_buffer == b && !NILP (B_ (other, name))) + if (other->base_buffer == b && !NILP (BVAR (other, name))) { Lisp_Object buffer; XSETBUFFER (buffer, other); @@ -1462,7 +1462,7 @@ /* Killing buffer processes may run sentinels which may have called kill-buffer. */ - if (NILP (B_ (b, name))) + if (NILP (BVAR (b, name))) return Qnil; clear_charpos_cache (b); @@ -1476,7 +1476,7 @@ /* Delete any auto-save file, if we saved it in this session. But not if the buffer is modified. */ - if (STRINGP (B_ (b, auto_save_file_name)) + if (STRINGP (BVAR (b, auto_save_file_name)) && BUF_AUTOSAVE_MODIFF (b) != 0 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) @@ -1485,7 +1485,7 @@ Lisp_Object tem; tem = Fsymbol_value (intern ("delete-auto-save-files")); if (! NILP (tem)) - internal_delete_file (B_ (b, auto_save_file_name)); + internal_delete_file (BVAR (b, auto_save_file_name)); } if (b->base_buffer) @@ -1525,7 +1525,7 @@ swap_out_buffer_local_variables (b); reset_buffer_local_variables (b, 1); - B_ (b, name) = Qnil; + BVAR (b, name) = Qnil; BLOCK_INPUT; if (! b->base_buffer) @@ -1541,9 +1541,9 @@ free_region_cache (b->width_run_cache); b->width_run_cache = 0; } - B_ (b, width_table) = Qnil; + BVAR (b, width_table) = Qnil; UNBLOCK_INPUT; - B_ (b, undo_list) = Qnil; + BVAR (b, undo_list) = Qnil; return Qt; } @@ -1637,15 +1637,15 @@ CHECK_BUFFER (buffer); - if (STRINGP (B_ (XBUFFER (buffer), name)) - && strcmp (SSDATA (B_ (XBUFFER (buffer), name)), "*scratch*") == 0) + if (STRINGP (BVAR (XBUFFER (buffer), name)) + && strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0) function = find_symbol_value (intern ("initial-major-mode")); else { - function = B_ (&buffer_defaults, major_mode); + function = BVAR (&buffer_defaults, major_mode); if (NILP (function) - && NILP (Fget (B_ (current_buffer, major_mode), Qmode_class))) - function = B_ (current_buffer, major_mode); + && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class))) + function = BVAR (current_buffer, major_mode); } if (NILP (function) || EQ (function, Qfundamental_mode)) @@ -1795,29 +1795,29 @@ /* Put the undo list back in the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (old_buf->base_buffer) - B_ (old_buf->base_buffer, undo_list) = B_ (old_buf, undo_list); + BVAR (old_buf->base_buffer, undo_list) = BVAR (old_buf, undo_list); /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ - if (! NILP (B_ (old_buf, pt_marker))) + if (! NILP (BVAR (old_buf, pt_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (B_ (old_buf, pt_marker), obuf, + set_marker_both (BVAR (old_buf, pt_marker), obuf, BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); } - if (! NILP (B_ (old_buf, begv_marker))) + if (! NILP (BVAR (old_buf, begv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (B_ (old_buf, begv_marker), obuf, + set_marker_both (BVAR (old_buf, begv_marker), obuf, BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); } - if (! NILP (B_ (old_buf, zv_marker))) + if (! NILP (BVAR (old_buf, zv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (B_ (old_buf, zv_marker), obuf, + set_marker_both (BVAR (old_buf, zv_marker), obuf, BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); } } @@ -1825,24 +1825,24 @@ /* Get the undo list from the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (b->base_buffer) - B_ (b, undo_list) = B_ (b->base_buffer, undo_list); + BVAR (b, undo_list) = BVAR (b->base_buffer, undo_list); /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ - if (! NILP (B_ (b, pt_marker))) - { - BUF_PT (b) = marker_position (B_ (b, pt_marker)); - BUF_PT_BYTE (b) = marker_byte_position (B_ (b, pt_marker)); - } - if (! NILP (B_ (b, begv_marker))) - { - BUF_BEGV (b) = marker_position (B_ (b, begv_marker)); - BUF_BEGV_BYTE (b) = marker_byte_position (B_ (b, begv_marker)); - } - if (! NILP (B_ (b, zv_marker))) - { - BUF_ZV (b) = marker_position (B_ (b, zv_marker)); - BUF_ZV_BYTE (b) = marker_byte_position (B_ (b, zv_marker)); + if (! NILP (BVAR (b, pt_marker))) + { + BUF_PT (b) = marker_position (BVAR (b, pt_marker)); + BUF_PT_BYTE (b) = marker_byte_position (BVAR (b, pt_marker)); + } + if (! NILP (BVAR (b, begv_marker))) + { + BUF_BEGV (b) = marker_position (BVAR (b, begv_marker)); + BUF_BEGV_BYTE (b) = marker_byte_position (BVAR (b, begv_marker)); + } + if (! NILP (BVAR (b, zv_marker))) + { + BUF_ZV (b) = marker_position (BVAR (b, zv_marker)); + BUF_ZV_BYTE (b) = marker_byte_position (BVAR (b, zv_marker)); } /* Look down buffer's list of local Lisp variables @@ -1850,7 +1850,7 @@ do { - for (tail = B_ (b, local_var_alist); CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail)) { Lisp_Object var = XCAR (XCAR (tail)); struct Lisp_Symbol *sym = XSYMBOL (var); @@ -1883,45 +1883,45 @@ { /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ - if (! NILP (B_ (old_buf, pt_marker))) + if (! NILP (BVAR (old_buf, pt_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (B_ (old_buf, pt_marker), obuf, + set_marker_both (BVAR (old_buf, pt_marker), obuf, BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); } - if (! NILP (B_ (old_buf, begv_marker))) + if (! NILP (BVAR (old_buf, begv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (B_ (old_buf, begv_marker), obuf, + set_marker_both (BVAR (old_buf, begv_marker), obuf, BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); } - if (! NILP (B_ (old_buf, zv_marker))) + if (! NILP (BVAR (old_buf, zv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (B_ (old_buf, zv_marker), obuf, + set_marker_both (BVAR (old_buf, zv_marker), obuf, BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); } } /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ - if (! NILP (B_ (b, pt_marker))) - { - BUF_PT (b) = marker_position (B_ (b, pt_marker)); - BUF_PT_BYTE (b) = marker_byte_position (B_ (b, pt_marker)); - } - if (! NILP (B_ (b, begv_marker))) - { - BUF_BEGV (b) = marker_position (B_ (b, begv_marker)); - BUF_BEGV_BYTE (b) = marker_byte_position (B_ (b, begv_marker)); - } - if (! NILP (B_ (b, zv_marker))) - { - BUF_ZV (b) = marker_position (B_ (b, zv_marker)); - BUF_ZV_BYTE (b) = marker_byte_position (B_ (b, zv_marker)); + if (! NILP (BVAR (b, pt_marker))) + { + BUF_PT (b) = marker_position (BVAR (b, pt_marker)); + BUF_PT_BYTE (b) = marker_byte_position (BVAR (b, pt_marker)); + } + if (! NILP (BVAR (b, begv_marker))) + { + BUF_BEGV (b) = marker_position (BVAR (b, begv_marker)); + BUF_BEGV_BYTE (b) = marker_byte_position (BVAR (b, begv_marker)); + } + if (! NILP (BVAR (b, zv_marker))) + { + BUF_ZV (b) = marker_position (BVAR (b, zv_marker)); + BUF_ZV_BYTE (b) = marker_byte_position (BVAR (b, zv_marker)); } } @@ -1938,7 +1938,7 @@ buffer = Fget_buffer (buffer_or_name); if (NILP (buffer)) nsberror (buffer_or_name); - if (NILP (B_ (XBUFFER (buffer), name))) + if (NILP (BVAR (XBUFFER (buffer), name))) error ("Selecting deleted buffer"); set_buffer_internal (XBUFFER (buffer)); return buffer; @@ -1949,7 +1949,7 @@ Lisp_Object set_buffer_if_live (Lisp_Object buffer) { - if (! NILP (B_ (XBUFFER (buffer), name))) + if (! NILP (BVAR (XBUFFER (buffer), name))) Fset_buffer (buffer); return Qnil; } @@ -1959,7 +1959,7 @@ doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */) (void) { - if (!NILP (B_ (current_buffer, read_only)) + if (!NILP (BVAR (current_buffer, read_only)) && NILP (Vinhibit_read_only)) xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); return Qnil; @@ -2008,7 +2008,7 @@ /* Move buffer to the end of the buffer list. Do nothing if the buffer is killed. */ - if (!NILP (B_ (XBUFFER (buffer), name))) + if (!NILP (BVAR (XBUFFER (buffer), name))) { Lisp_Object aelt, link; @@ -2041,7 +2041,7 @@ /* Prevent warnings, or suspension of auto saving, that would happen if future size is less than past size. Use of erase-buffer implies that the future text is not really related to the past text. */ - XSETFASTINT (B_ (current_buffer, save_length), 0); + XSETFASTINT (BVAR (current_buffer, save_length), 0); return Qnil; } @@ -2111,7 +2111,7 @@ CHECK_BUFFER (buffer); other_buffer = XBUFFER (buffer); - if (NILP (B_ (other_buffer, name))) + if (NILP (BVAR (other_buffer, name))) error ("Cannot swap a dead buffer's text"); /* Actually, it probably works just fine. @@ -2140,9 +2140,9 @@ } while (0) #define swapfield_(field, type) \ do { \ - type tmp##field = B_ (other_buffer, field); \ - B_ (other_buffer, field) = B_ (current_buffer, field); \ - B_ (current_buffer, field) = tmp##field; \ + type tmp##field = BVAR (other_buffer, field); \ + BVAR (other_buffer, field) = BVAR (current_buffer, field); \ + BVAR (current_buffer, field) = tmp##field; \ } while (0) swapfield (own_text, struct buffer_text); @@ -2181,8 +2181,8 @@ swapfield_ (pt_marker, Lisp_Object); swapfield_ (begv_marker, Lisp_Object); swapfield_ (zv_marker, Lisp_Object); - B_ (current_buffer, point_before_scroll) = Qnil; - B_ (other_buffer, point_before_scroll) = Qnil; + BVAR (current_buffer, point_before_scroll) = Qnil; + BVAR (other_buffer, point_before_scroll) = Qnil; current_buffer->text->modiff++; other_buffer->text->modiff++; current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++; @@ -2256,21 +2256,21 @@ EMACS_INT begv, zv; int narrowed = (BEG != BEGV || Z != ZV); int modified_p = !NILP (Fbuffer_modified_p (Qnil)); - Lisp_Object old_undo = B_ (current_buffer, undo_list); + Lisp_Object old_undo = BVAR (current_buffer, undo_list); struct gcpro gcpro1; if (current_buffer->base_buffer) error ("Cannot do `set-buffer-multibyte' on an indirect buffer"); /* Do nothing if nothing actually changes. */ - if (NILP (flag) == NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters))) return flag; GCPRO1 (old_undo); /* Don't record these buffer changes. We will put a special undo entry instead. */ - B_ (current_buffer, undo_list) = Qt; + BVAR (current_buffer, undo_list) = Qt; /* If the cached position is for this buffer, clear it out. */ clear_charpos_cache (current_buffer); @@ -2292,7 +2292,7 @@ to calculate the old correspondences. */ set_intervals_multibyte (0); - B_ (current_buffer, enable_multibyte_characters) = Qnil; + BVAR (current_buffer, enable_multibyte_characters) = Qnil; Z = Z_BYTE; BEGV = BEGV_BYTE; @@ -2430,7 +2430,7 @@ /* Do this first, so that chars_in_text asks the right question. set_intervals_multibyte needs it too. */ - B_ (current_buffer, enable_multibyte_characters) = Qt; + BVAR (current_buffer, enable_multibyte_characters) = Qt; GPT_BYTE = advance_to_char_boundary (GPT_BYTE); GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG; @@ -2488,7 +2488,7 @@ if (!EQ (old_undo, Qt)) { /* Represent all the above changes by a special undo entry. */ - B_ (current_buffer, undo_list) = Fcons (list3 (Qapply, + BVAR (current_buffer, undo_list) = Fcons (list3 (Qapply, intern ("set-buffer-multibyte"), NILP (flag) ? Qt : Qnil), old_undo); @@ -2504,10 +2504,10 @@ /* Copy this buffer's new multibyte status into all of its indirect buffers. */ for (other = all_buffers; other; other = other->next) - if (other->base_buffer == current_buffer && !NILP (B_ (other, name))) + if (other->base_buffer == current_buffer && !NILP (BVAR (other, name))) { - B_ (other, enable_multibyte_characters) - = B_ (current_buffer, enable_multibyte_characters); + BVAR (other, enable_multibyte_characters) + = BVAR (current_buffer, enable_multibyte_characters); other->prevent_redisplay_optimizations_p = 1; } @@ -2574,7 +2574,7 @@ Lisp_Object oalist, alist, buffer; XSETBUFFER (buffer, b); - oalist = B_ (b, local_var_alist); + oalist = BVAR (b, local_var_alist); for (alist = oalist; CONSP (alist); alist = XCDR (alist)) { @@ -3078,7 +3078,7 @@ ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); ssl->used++; - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nbytes = SCHARS (str); else if (! STRING_MULTIBYTE (str)) nbytes = count_size_as_multibyte (SDATA (str), @@ -3090,7 +3090,7 @@ if (STRINGP (str2)) { - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nbytes = SCHARS (str2); else if (! STRING_MULTIBYTE (str2)) nbytes = count_size_as_multibyte (SDATA (str2), @@ -3120,7 +3120,7 @@ Lisp_Object overlay, window, str; struct Lisp_Overlay *ov; EMACS_INT startpos, endpos; - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); overlay_heads.used = overlay_heads.bytes = 0; overlay_tails.used = overlay_tails.bytes = 0; @@ -4991,9 +4991,9 @@ /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); - eassert (EQ (B_ (&buffer_defaults, name), make_number (0))); + eassert (EQ (BVAR (&buffer_defaults, name), make_number (0))); reset_buffer_local_variables (&buffer_defaults, 1); - eassert (EQ (B_ (&buffer_local_symbols, name), make_number (0))); + eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0))); reset_buffer (&buffer_local_symbols); reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ @@ -5010,60 +5010,60 @@ /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - B_ (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); - B_ (&buffer_defaults, header_line_format) = Qnil; - B_ (&buffer_defaults, abbrev_mode) = Qnil; - B_ (&buffer_defaults, overwrite_mode) = Qnil; - B_ (&buffer_defaults, case_fold_search) = Qt; - B_ (&buffer_defaults, auto_fill_function) = Qnil; - B_ (&buffer_defaults, selective_display) = Qnil; + BVAR (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); + BVAR (&buffer_defaults, header_line_format) = Qnil; + BVAR (&buffer_defaults, abbrev_mode) = Qnil; + BVAR (&buffer_defaults, overwrite_mode) = Qnil; + BVAR (&buffer_defaults, case_fold_search) = Qt; + BVAR (&buffer_defaults, auto_fill_function) = Qnil; + BVAR (&buffer_defaults, selective_display) = Qnil; #ifndef old - B_ (&buffer_defaults, selective_display_ellipses) = Qt; + BVAR (&buffer_defaults, selective_display_ellipses) = Qt; #endif - B_ (&buffer_defaults, abbrev_table) = Qnil; - B_ (&buffer_defaults, display_table) = Qnil; - B_ (&buffer_defaults, undo_list) = Qnil; - B_ (&buffer_defaults, mark_active) = Qnil; - B_ (&buffer_defaults, file_format) = Qnil; - B_ (&buffer_defaults, auto_save_file_format) = Qt; + BVAR (&buffer_defaults, abbrev_table) = Qnil; + BVAR (&buffer_defaults, display_table) = Qnil; + BVAR (&buffer_defaults, undo_list) = Qnil; + BVAR (&buffer_defaults, mark_active) = Qnil; + BVAR (&buffer_defaults, file_format) = Qnil; + BVAR (&buffer_defaults, auto_save_file_format) = Qt; buffer_defaults.overlays_before = NULL; buffer_defaults.overlays_after = NULL; buffer_defaults.overlay_center = BEG; - XSETFASTINT (B_ (&buffer_defaults, tab_width), 8); - B_ (&buffer_defaults, truncate_lines) = Qnil; - B_ (&buffer_defaults, word_wrap) = Qnil; - B_ (&buffer_defaults, ctl_arrow) = Qt; - B_ (&buffer_defaults, bidi_display_reordering) = Qnil; - B_ (&buffer_defaults, bidi_paragraph_direction) = Qnil; - B_ (&buffer_defaults, cursor_type) = Qt; - B_ (&buffer_defaults, extra_line_spacing) = Qnil; - B_ (&buffer_defaults, cursor_in_non_selected_windows) = Qt; + XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8); + BVAR (&buffer_defaults, truncate_lines) = Qnil; + BVAR (&buffer_defaults, word_wrap) = Qnil; + BVAR (&buffer_defaults, ctl_arrow) = Qt; + BVAR (&buffer_defaults, bidi_display_reordering) = Qnil; + BVAR (&buffer_defaults, bidi_paragraph_direction) = Qnil; + BVAR (&buffer_defaults, cursor_type) = Qt; + BVAR (&buffer_defaults, extra_line_spacing) = Qnil; + BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt; #ifdef DOS_NT - B_ (&buffer_defaults, buffer_file_type) = Qnil; /* TEXT */ + BVAR (&buffer_defaults, buffer_file_type) = Qnil; /* TEXT */ #endif - B_ (&buffer_defaults, enable_multibyte_characters) = Qt; - B_ (&buffer_defaults, buffer_file_coding_system) = Qnil; - XSETFASTINT (B_ (&buffer_defaults, fill_column), 70); - XSETFASTINT (B_ (&buffer_defaults, left_margin), 0); - B_ (&buffer_defaults, cache_long_line_scans) = Qnil; - B_ (&buffer_defaults, file_truename) = Qnil; - XSETFASTINT (B_ (&buffer_defaults, display_count), 0); - XSETFASTINT (B_ (&buffer_defaults, left_margin_cols), 0); - XSETFASTINT (B_ (&buffer_defaults, right_margin_cols), 0); - B_ (&buffer_defaults, left_fringe_width) = Qnil; - B_ (&buffer_defaults, right_fringe_width) = Qnil; - B_ (&buffer_defaults, fringes_outside_margins) = Qnil; - B_ (&buffer_defaults, scroll_bar_width) = Qnil; - B_ (&buffer_defaults, vertical_scroll_bar_type) = Qt; - B_ (&buffer_defaults, indicate_empty_lines) = Qnil; - B_ (&buffer_defaults, indicate_buffer_boundaries) = Qnil; - B_ (&buffer_defaults, fringe_indicator_alist) = Qnil; - B_ (&buffer_defaults, fringe_cursor_alist) = Qnil; - B_ (&buffer_defaults, scroll_up_aggressively) = Qnil; - B_ (&buffer_defaults, scroll_down_aggressively) = Qnil; - B_ (&buffer_defaults, display_time) = Qnil; + BVAR (&buffer_defaults, enable_multibyte_characters) = Qt; + BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil; + XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70); + XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0); + BVAR (&buffer_defaults, cache_long_line_scans) = Qnil; + BVAR (&buffer_defaults, file_truename) = Qnil; + XSETFASTINT (BVAR (&buffer_defaults, display_count), 0); + XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0); + XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0); + BVAR (&buffer_defaults, left_fringe_width) = Qnil; + BVAR (&buffer_defaults, right_fringe_width) = Qnil; + BVAR (&buffer_defaults, fringes_outside_margins) = Qnil; + BVAR (&buffer_defaults, scroll_bar_width) = Qnil; + BVAR (&buffer_defaults, vertical_scroll_bar_type) = Qt; + BVAR (&buffer_defaults, indicate_empty_lines) = Qnil; + BVAR (&buffer_defaults, indicate_buffer_boundaries) = Qnil; + BVAR (&buffer_defaults, fringe_indicator_alist) = Qnil; + BVAR (&buffer_defaults, fringe_cursor_alist) = Qnil; + BVAR (&buffer_defaults, scroll_up_aggressively) = Qnil; + BVAR (&buffer_defaults, scroll_down_aggressively) = Qnil; + BVAR (&buffer_defaults, display_time) = Qnil; /* Assign the local-flags to the slots that have default values. The local flag is a bit that is used in the buffer @@ -5075,73 +5075,73 @@ /* 0 means not a lisp var, -1 means always local, else mask */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); - XSETINT (B_ (&buffer_local_flags, filename), -1); - XSETINT (B_ (&buffer_local_flags, directory), -1); - XSETINT (B_ (&buffer_local_flags, backed_up), -1); - XSETINT (B_ (&buffer_local_flags, save_length), -1); - XSETINT (B_ (&buffer_local_flags, auto_save_file_name), -1); - XSETINT (B_ (&buffer_local_flags, read_only), -1); - XSETINT (B_ (&buffer_local_flags, major_mode), -1); - XSETINT (B_ (&buffer_local_flags, mode_name), -1); - XSETINT (B_ (&buffer_local_flags, undo_list), -1); - XSETINT (B_ (&buffer_local_flags, mark_active), -1); - XSETINT (B_ (&buffer_local_flags, point_before_scroll), -1); - XSETINT (B_ (&buffer_local_flags, file_truename), -1); - XSETINT (B_ (&buffer_local_flags, invisibility_spec), -1); - XSETINT (B_ (&buffer_local_flags, file_format), -1); - XSETINT (B_ (&buffer_local_flags, auto_save_file_format), -1); - XSETINT (B_ (&buffer_local_flags, display_count), -1); - XSETINT (B_ (&buffer_local_flags, display_time), -1); - XSETINT (B_ (&buffer_local_flags, enable_multibyte_characters), -1); + XSETINT (BVAR (&buffer_local_flags, filename), -1); + XSETINT (BVAR (&buffer_local_flags, directory), -1); + XSETINT (BVAR (&buffer_local_flags, backed_up), -1); + XSETINT (BVAR (&buffer_local_flags, save_length), -1); + XSETINT (BVAR (&buffer_local_flags, auto_save_file_name), -1); + XSETINT (BVAR (&buffer_local_flags, read_only), -1); + XSETINT (BVAR (&buffer_local_flags, major_mode), -1); + XSETINT (BVAR (&buffer_local_flags, mode_name), -1); + XSETINT (BVAR (&buffer_local_flags, undo_list), -1); + XSETINT (BVAR (&buffer_local_flags, mark_active), -1); + XSETINT (BVAR (&buffer_local_flags, point_before_scroll), -1); + XSETINT (BVAR (&buffer_local_flags, file_truename), -1); + XSETINT (BVAR (&buffer_local_flags, invisibility_spec), -1); + XSETINT (BVAR (&buffer_local_flags, file_format), -1); + XSETINT (BVAR (&buffer_local_flags, auto_save_file_format), -1); + XSETINT (BVAR (&buffer_local_flags, display_count), -1); + XSETINT (BVAR (&buffer_local_flags, display_time), -1); + XSETINT (BVAR (&buffer_local_flags, enable_multibyte_characters), -1); idx = 1; - XSETFASTINT (B_ (&buffer_local_flags, mode_line_format), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, abbrev_mode), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, overwrite_mode), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, case_fold_search), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, auto_fill_function), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, selective_display), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx; #ifndef old - XSETFASTINT (B_ (&buffer_local_flags, selective_display_ellipses), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx; #endif - XSETFASTINT (B_ (&buffer_local_flags, tab_width), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, truncate_lines), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, word_wrap), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, ctl_arrow), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, fill_column), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, left_margin), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, abbrev_table), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, display_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx; #ifdef DOS_NT - XSETFASTINT (B_ (&buffer_local_flags, buffer_file_type), idx); + XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_type), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; #endif - XSETFASTINT (B_ (&buffer_local_flags, syntax_table), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, cache_long_line_scans), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, category_table), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, bidi_display_reordering), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, buffer_file_coding_system), idx); + XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, cache_long_line_scans), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; - XSETFASTINT (B_ (&buffer_local_flags, left_margin_cols), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, right_margin_cols), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, left_fringe_width), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, right_fringe_width), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, fringes_outside_margins), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, scroll_bar_width), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, indicate_empty_lines), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, header_line_format), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, cursor_type), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, extra_line_spacing), idx); ++idx; - XSETFASTINT (B_ (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; /* Need more room? */ if (idx >= MAX_PER_BUFFER_VARS) @@ -5155,7 +5155,7 @@ QSFundamental = make_pure_c_string ("Fundamental"); Qfundamental_mode = intern_c_string ("fundamental-mode"); - B_ (&buffer_defaults, major_mode) = Qfundamental_mode; + BVAR (&buffer_defaults, major_mode) = Qfundamental_mode; Qmode_class = intern_c_string ("mode-class"); @@ -5198,7 +5198,7 @@ #endif /* USE_MMAP_FOR_BUFFERS */ Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); - if (NILP (B_ (&buffer_defaults, enable_multibyte_characters))) + if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) Fset_buffer_multibyte (Qnil); pwd = get_current_dir_name (); @@ -5219,28 +5219,28 @@ pwd[len + 1] = '\0'; } - B_ (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); - if (! NILP (B_ (&buffer_defaults, enable_multibyte_characters))) + BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); + if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in multibyte form so that ENCODE_FILE correctly gets the original bytes. */ - B_ (current_buffer, directory) - = string_to_multibyte (B_ (current_buffer, directory)); + BVAR (current_buffer, directory) + = string_to_multibyte (BVAR (current_buffer, directory)); /* Add /: to the front of the name if it would otherwise be treated as magic. */ - temp = Ffind_file_name_handler (B_ (current_buffer, directory), Qt); + temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt); if (! NILP (temp) /* If the default dir is just /, TEMP is non-nil because of the ange-ftp completion handler. However, it is not necessary to turn / into /:/. So avoid doing that. */ - && strcmp ("/", SSDATA (B_ (current_buffer, directory)))) - B_ (current_buffer, directory) - = concat2 (build_string ("/:"), B_ (current_buffer, directory)); + && strcmp ("/", SSDATA (BVAR (current_buffer, directory)))) + BVAR (current_buffer, directory) + = concat2 (build_string ("/:"), BVAR (current_buffer, directory)); temp = get_minibuffer (0); - B_ (XBUFFER (temp), directory) = B_ (current_buffer, directory); + BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory); free (pwd); } @@ -5491,13 +5491,13 @@ This is the same as (default-value 'scroll-down-aggressively). */); DEFVAR_PER_BUFFER ("header-line-format", - &B_ (current_buffer, header_line_format), + &BVAR (current_buffer, header_line_format), Qnil, doc: /* Analogous to `mode-line-format', but controls the header line. The header line appears, optionally, at the top of a window; the mode line appears at the bottom. */); - DEFVAR_PER_BUFFER ("mode-line-format", &B_ (current_buffer, mode_line_format), + DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format), Qnil, doc: /* Template for displaying mode line for current buffer. Each buffer has its own value of this variable. @@ -5554,7 +5554,7 @@ DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode, doc: /* *Value of `major-mode' for new buffers. */); - DEFVAR_PER_BUFFER ("major-mode", &B_ (current_buffer, major_mode), + DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode), make_number (Lisp_Symbol), doc: /* Symbol for current buffer's major mode. The default value (normally `fundamental-mode') affects new buffers. @@ -5567,46 +5567,46 @@ variables such as `buffer-read-only' and `buffer-file-coding-system' to be set up. */); - DEFVAR_PER_BUFFER ("mode-name", &B_ (current_buffer, mode_name), + DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name), Qnil, doc: /* Pretty name of current buffer's major mode. Usually a string, but can use any of the constructs for `mode-line-format', which see. Format with `format-mode-line' to produce a string value. */); - DEFVAR_PER_BUFFER ("local-abbrev-table", &B_ (current_buffer, abbrev_table), Qnil, + DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil, doc: /* Local (mode-specific) abbrev table of current buffer. */); - DEFVAR_PER_BUFFER ("abbrev-mode", &B_ (current_buffer, abbrev_mode), Qnil, + DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil, doc: /* Non-nil if Abbrev mode is enabled. Use the command `abbrev-mode' to change this variable. */); - DEFVAR_PER_BUFFER ("case-fold-search", &B_ (current_buffer, case_fold_search), + DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search), Qnil, doc: /* *Non-nil if searches and matches should ignore case. */); - DEFVAR_PER_BUFFER ("fill-column", &B_ (current_buffer, fill_column), + DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column), make_number (LISP_INT_TAG), doc: /* *Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using \\[set-fill-column]. */); - DEFVAR_PER_BUFFER ("left-margin", &B_ (current_buffer, left_margin), + DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin), make_number (LISP_INT_TAG), doc: /* *Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode. */); - DEFVAR_PER_BUFFER ("tab-width", &B_ (current_buffer, tab_width), + DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width), make_number (LISP_INT_TAG), doc: /* *Distance between tab stops (for display of tab characters), in columns. */); - DEFVAR_PER_BUFFER ("ctl-arrow", &B_ (current_buffer, ctl_arrow), Qnil, + DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil, doc: /* *Non-nil means display control chars with uparrow. A value of nil means use backslash and octal digits. This variable does not apply to characters whose display is specified in the current display table (if there is one). */); DEFVAR_PER_BUFFER ("enable-multibyte-characters", - &B_ (current_buffer, enable_multibyte_characters), + &BVAR (current_buffer, enable_multibyte_characters), Qnil, doc: /* Non-nil means the buffer contents are regarded as multi-byte characters. Otherwise they are regarded as unibyte. This affects the display, @@ -5620,7 +5620,7 @@ XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; DEFVAR_PER_BUFFER ("buffer-file-coding-system", - &B_ (current_buffer, buffer_file_coding_system), Qnil, + &BVAR (current_buffer, buffer_file_coding_system), Qnil, doc: /* Coding system to be used for encoding the buffer contents on saving. This variable applies to saving the buffer, and also to `write-region' and other functions that use `write-region'. @@ -5638,11 +5638,11 @@ This variable is never applied to a way of decoding a file while reading it. */); DEFVAR_PER_BUFFER ("bidi-display-reordering", - &B_ (current_buffer, bidi_display_reordering), Qnil, + &BVAR (current_buffer, bidi_display_reordering), Qnil, doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); DEFVAR_PER_BUFFER ("bidi-paragraph-direction", - &B_ (current_buffer, bidi_paragraph_direction), Qnil, + &BVAR (current_buffer, bidi_paragraph_direction), Qnil, doc: /* *If non-nil, forces directionality of text paragraphs in the buffer. If this is nil (the default), the direction of each paragraph is @@ -5653,7 +5653,7 @@ This variable has no effect unless the buffer's value of \`bidi-display-reordering' is non-nil. */); - DEFVAR_PER_BUFFER ("truncate-lines", &B_ (current_buffer, truncate_lines), Qnil, + DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil, doc: /* *Non-nil means do not display continuation lines. Instead, give each line of text just one screen line. @@ -5661,7 +5661,7 @@ `truncate-partial-width-windows' if that variable is non-nil and this buffer is not full-frame width. */); - DEFVAR_PER_BUFFER ("word-wrap", &B_ (current_buffer, word_wrap), Qnil, + DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil, doc: /* *Non-nil means to use word-wrapping for continuation lines. When word-wrapping is on, continuation lines are wrapped at the space or tab character nearest to the right window edge. @@ -5674,7 +5674,7 @@ in narrower windows. */); #ifdef DOS_NT - DEFVAR_PER_BUFFER ("buffer-file-type", &B_ (current_buffer, buffer_file_type), + DEFVAR_PER_BUFFER ("buffer-file-type", &BVAR (current_buffer, buffer_file_type), Qnil, doc: /* Non-nil if the visited file is a binary file. This variable is meaningful on MS-DOG and Windows NT. @@ -5682,12 +5682,12 @@ On other systems, this variable is normally always nil. */); #endif - DEFVAR_PER_BUFFER ("default-directory", &B_ (current_buffer, directory), + DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), make_number (Lisp_String), doc: /* Name of default directory of current buffer. Should end with slash. To interactively change the default directory, use command `cd'. */); - DEFVAR_PER_BUFFER ("auto-fill-function", &B_ (current_buffer, auto_fill_function), + DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function), Qnil, doc: /* Function called (if non-nil) to perform auto-fill. It is called after self-inserting any character specified in @@ -5695,30 +5695,30 @@ NOTE: This variable is not a hook; its value may not be a list of functions. */); - DEFVAR_PER_BUFFER ("buffer-file-name", &B_ (current_buffer, filename), + DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename), make_number (Lisp_String), doc: /* Name of file visited in current buffer, or nil if not visiting a file. */); - DEFVAR_PER_BUFFER ("buffer-file-truename", &B_ (current_buffer, file_truename), + DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename), make_number (Lisp_String), doc: /* Abbreviated truename of file visited in current buffer, or nil if none. The truename of a file is calculated by `file-truename' and then abbreviated with `abbreviate-file-name'. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", - &B_ (current_buffer, auto_save_file_name), + &BVAR (current_buffer, auto_save_file_name), make_number (Lisp_String), doc: /* Name of file for auto-saving current buffer. If it is nil, that means don't auto-save this buffer. */); - DEFVAR_PER_BUFFER ("buffer-read-only", &B_ (current_buffer, read_only), Qnil, + DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil, doc: /* Non-nil if this buffer is read-only. */); - DEFVAR_PER_BUFFER ("buffer-backed-up", &B_ (current_buffer, backed_up), Qnil, + DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil, doc: /* Non-nil if this buffer's file has been backed up. Backing up is done before the first time the file is saved. */); - DEFVAR_PER_BUFFER ("buffer-saved-size", &B_ (current_buffer, save_length), + DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length), make_number (LISP_INT_TAG), doc: /* Length of current buffer when last read in, saved or auto-saved. 0 initially. @@ -5728,7 +5728,7 @@ if its text size shrinks. If you use `buffer-swap-text' on a buffer, you probably should set this to -2 in that buffer. */); - DEFVAR_PER_BUFFER ("selective-display", &B_ (current_buffer, selective_display), + DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display), Qnil, doc: /* Non-nil enables selective display. An integer N as value means display only lines @@ -5739,12 +5739,12 @@ #ifndef old DEFVAR_PER_BUFFER ("selective-display-ellipses", - &B_ (current_buffer, selective_display_ellipses), + &BVAR (current_buffer, selective_display_ellipses), Qnil, doc: /* Non-nil means display ... on previous line when a line is invisible. */); #endif - DEFVAR_PER_BUFFER ("overwrite-mode", &B_ (current_buffer, overwrite_mode), Qnil, + DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil, doc: /* Non-nil if self-insertion should replace existing text. The value should be one of `overwrite-mode-textual', `overwrite-mode-binary', or nil. @@ -5753,7 +5753,7 @@ until the tab is filled in. If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */); - DEFVAR_PER_BUFFER ("buffer-display-table", &B_ (current_buffer, display_table), + DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table), Qnil, doc: /* Display table that controls display of the contents of current buffer. @@ -5790,39 +5790,39 @@ See also the functions `display-table-slot' and `set-display-table-slot'. */); - DEFVAR_PER_BUFFER ("left-margin-width", &B_ (current_buffer, left_margin_cols), + DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), Qnil, doc: /* *Width of left marginal area for display of a buffer. A value of nil means no marginal area. */); - DEFVAR_PER_BUFFER ("right-margin-width", &B_ (current_buffer, right_margin_cols), + DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), Qnil, doc: /* *Width of right marginal area for display of a buffer. A value of nil means no marginal area. */); - DEFVAR_PER_BUFFER ("left-fringe-width", &B_ (current_buffer, left_fringe_width), + DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), Qnil, doc: /* *Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame. */); - DEFVAR_PER_BUFFER ("right-fringe-width", &B_ (current_buffer, right_fringe_width), + DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), Qnil, doc: /* *Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame. */); - DEFVAR_PER_BUFFER ("fringes-outside-margins", &B_ (current_buffer, fringes_outside_margins), + DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins), Qnil, doc: /* *Non-nil means to display fringes outside display margins. A value of nil means to display fringes between margins and buffer text. */); - DEFVAR_PER_BUFFER ("scroll-bar-width", &B_ (current_buffer, scroll_bar_width), + DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), Qnil, doc: /* *Width of this buffer's scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame. */); - DEFVAR_PER_BUFFER ("vertical-scroll-bar", &B_ (current_buffer, vertical_scroll_bar_type), + DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type), Qnil, doc: /* *Position of this buffer's vertical scroll bar. The value takes effect whenever you tell a window to display this buffer; @@ -5833,13 +5833,13 @@ A value of t (the default) means do whatever the window's frame specifies. */); DEFVAR_PER_BUFFER ("indicate-empty-lines", - &B_ (current_buffer, indicate_empty_lines), Qnil, + &BVAR (current_buffer, indicate_empty_lines), Qnil, doc: /* *Visually indicate empty lines after the buffer end. If non-nil, a bitmap is displayed in the left fringe of a window on window-systems. */); DEFVAR_PER_BUFFER ("indicate-buffer-boundaries", - &B_ (current_buffer, indicate_buffer_boundaries), Qnil, + &BVAR (current_buffer, indicate_buffer_boundaries), Qnil, doc: /* *Visually indicate buffer boundaries and scrolling. If non-nil, the first and last line of the buffer are marked in the fringe of a window on window-systems with angle bitmaps, or if the window can be @@ -5864,7 +5864,7 @@ fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */); DEFVAR_PER_BUFFER ("fringe-indicator-alist", - &B_ (current_buffer, fringe_indicator_alist), Qnil, + &BVAR (current_buffer, fringe_indicator_alist), Qnil, doc: /* *Mapping from logical to physical fringe indicator bitmaps. The value is an alist where each element (INDICATOR . BITMAPS) specifies the fringe bitmaps used to display a specific logical @@ -5883,7 +5883,7 @@ symbol which is used in both left and right fringes. */); DEFVAR_PER_BUFFER ("fringe-cursor-alist", - &B_ (current_buffer, fringe_cursor_alist), Qnil, + &BVAR (current_buffer, fringe_cursor_alist), Qnil, doc: /* *Mapping from logical to physical fringe cursor bitmaps. The value is an alist where each element (CURSOR . BITMAP) specifies the fringe bitmaps used to display a specific logical @@ -5898,7 +5898,7 @@ cursor type. */); DEFVAR_PER_BUFFER ("scroll-up-aggressively", - &B_ (current_buffer, scroll_up_aggressively), Qnil, + &BVAR (current_buffer, scroll_up_aggressively), Qnil, doc: /* How far to scroll windows upward. If you move point off the bottom, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -5911,7 +5911,7 @@ between 0.0 and 1.0, inclusive. */); DEFVAR_PER_BUFFER ("scroll-down-aggressively", - &B_ (current_buffer, scroll_down_aggressively), Qnil, + &BVAR (current_buffer, scroll_down_aggressively), Qnil, doc: /* How far to scroll windows downward. If you move point off the top, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -5966,7 +5966,7 @@ The functions are run using the `run-hooks' function. */); Vfirst_change_hook = Qnil; - DEFVAR_PER_BUFFER ("buffer-undo-list", &B_ (current_buffer, undo_list), Qnil, + DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil, doc: /* List of undo entries in current buffer. Recent changes come first; older changes follow newer. @@ -6007,10 +6007,10 @@ If the value of the variable is t, undo information is not recorded. */); - DEFVAR_PER_BUFFER ("mark-active", &B_ (current_buffer, mark_active), Qnil, + DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil, doc: /* Non-nil means the mark and region are currently active in this buffer. */); - DEFVAR_PER_BUFFER ("cache-long-line-scans", &B_ (current_buffer, cache_long_line_scans), Qnil, + DEFVAR_PER_BUFFER ("cache-long-line-scans", &BVAR (current_buffer, cache_long_line_scans), Qnil, doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly. Normally, the line-motion functions work by scanning the buffer for @@ -6038,23 +6038,23 @@ the cache should not affect the behavior of any of the motion functions; it should only affect their performance. */); - DEFVAR_PER_BUFFER ("point-before-scroll", &B_ (current_buffer, point_before_scroll), Qnil, + DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil, doc: /* Value of point before the last series of scroll operations, or nil. */); - DEFVAR_PER_BUFFER ("buffer-file-format", &B_ (current_buffer, file_format), Qnil, + DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil, doc: /* List of formats to use when saving this buffer. Formats are defined by `format-alist'. This variable is set when a file is visited. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-format", - &B_ (current_buffer, auto_save_file_format), Qnil, + &BVAR (current_buffer, auto_save_file_format), Qnil, doc: /* *Format in which to write auto-save files. Should be a list of symbols naming formats that are defined in `format-alist'. If it is t, which is the default, auto-save files are written in the same format as a regular save would use. */); DEFVAR_PER_BUFFER ("buffer-invisibility-spec", - &B_ (current_buffer, invisibility_spec), Qnil, + &BVAR (current_buffer, invisibility_spec), Qnil, doc: /* Invisibility spec of this buffer. The default is t, which means that text is invisible if it has a non-nil `invisible' property. @@ -6065,12 +6065,12 @@ and they have an ellipsis as well if ELLIPSIS is non-nil. */); DEFVAR_PER_BUFFER ("buffer-display-count", - &B_ (current_buffer, display_count), Qnil, + &BVAR (current_buffer, display_count), Qnil, doc: /* A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it. */); DEFVAR_PER_BUFFER ("buffer-display-time", - &B_ (current_buffer, display_time), Qnil, + &BVAR (current_buffer, display_time), Qnil, doc: /* Time stamp updated each time this buffer is displayed in a window. The function `set-window-buffer' updates this variable to the value obtained by calling `current-time'. @@ -6105,7 +6105,7 @@ is a member of the list. */); Vinhibit_read_only = Qnil; - DEFVAR_PER_BUFFER ("cursor-type", &B_ (current_buffer, cursor_type), Qnil, + DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil, doc: /* Cursor to use when this buffer is in the selected window. Values are interpreted as follows: @@ -6124,7 +6124,7 @@ `cursor-in-non-selected-windows'. */); DEFVAR_PER_BUFFER ("line-spacing", - &B_ (current_buffer, extra_line_spacing), Qnil, + &BVAR (current_buffer, extra_line_spacing), Qnil, doc: /* Additional space to put between lines when displaying a buffer. The space is measured in pixels, and put below lines on graphic displays, see `display-graphic-p'. @@ -6132,7 +6132,7 @@ to the default frame line height. A value of nil means add no extra space. */); DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", - &B_ (current_buffer, cursor_in_non_selected_windows), Qnil, + &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil, doc: /* *Non-nil means show a cursor in non-selected windows. If nil, only shows a cursor in the selected window. If t, displays a cursor related to the usual cursor type === modified file 'src/buffer.h' --- src/buffer.h 2011-02-14 15:39:19 +0000 +++ src/buffer.h 2011-02-16 15:02:50 +0000 @@ -321,7 +321,7 @@ /* Return character at byte position POS. */ #define FETCH_CHAR(pos) \ - (!NILP (B_ (current_buffer, enable_multibyte_characters)) \ + (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \ ? FETCH_MULTIBYTE_CHAR ((pos)) \ : FETCH_BYTE ((pos))) @@ -346,7 +346,7 @@ multibyte. */ #define FETCH_CHAR_AS_MULTIBYTE(pos) \ - (!NILP (B_ (current_buffer, enable_multibyte_characters)) \ + (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \ ? FETCH_MULTIBYTE_CHAR ((pos)) \ : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos)))) @@ -465,13 +465,13 @@ }; /* Lisp fields in struct buffer are hidden from most code and accessed - via the B_ macro, below. Only select pieces of code, like the GC, + via the BVAR macro, below. Only select pieces of code, like the GC, are allowed to use BUFFER_INTERNAL_FIELD. */ #define BUFFER_INTERNAL_FIELD(field) field ## _ /* Most code should use this macro to access Lisp fields in struct buffer. */ -#define B_(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field)) +#define BVAR(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field)) /* This is the structure that the buffer Lisp object points to. */ === modified file 'src/bytecode.c' --- src/bytecode.c 2011-02-14 15:39:19 +0000 +++ src/bytecode.c 2011-02-16 15:02:50 +0000 @@ -1398,7 +1398,7 @@ CHECK_CHARACTER (TOP); AFTER_POTENTIAL_GC (); c = XFASTINT (TOP); - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) MAKE_CHAR_MULTIBYTE (c); XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]); } === modified file 'src/callint.c' --- src/callint.c 2011-02-14 15:39:19 +0000 +++ src/callint.c 2011-02-16 15:02:50 +0000 @@ -149,12 +149,12 @@ check_mark (int for_region) { Lisp_Object tem; - tem = Fmarker_buffer (B_ (current_buffer, mark)); + tem = Fmarker_buffer (BVAR (current_buffer, mark)); if (NILP (tem) || (XBUFFER (tem) != current_buffer)) error (for_region ? "The mark is not set now, so there is no region" : "The mark is not set now"); if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) - && NILP (B_ (current_buffer, mark_active))) + && NILP (BVAR (current_buffer, mark_active))) xsignal0 (Qmark_inactive); } @@ -385,7 +385,7 @@ else if (*string == '*') { string++; - if (!NILP (B_ (current_buffer, read_only))) + if (!NILP (BVAR (current_buffer, read_only))) { if (!NILP (record_flag)) { @@ -543,7 +543,7 @@ case 'D': /* Directory name. */ args[i] = Fread_file_name (callint_message, Qnil, - B_ (current_buffer, directory), Qlambda, Qnil, + BVAR (current_buffer, directory), Qlambda, Qnil, Qfile_directory_p); break; @@ -661,7 +661,7 @@ case 'm': /* Value of mark. Does not do I/O. */ check_mark (0); /* visargs[i] = Qnil; */ - args[i] = B_ (current_buffer, mark); + args[i] = BVAR (current_buffer, mark); varies[i] = 2; break; @@ -717,11 +717,11 @@ check_mark (1); set_marker_both (point_marker, Qnil, PT, PT_BYTE); /* visargs[i+1] = Qnil; */ - foo = marker_position (B_ (current_buffer, mark)); + foo = marker_position (BVAR (current_buffer, mark)); /* visargs[i] = Qnil; */ - args[i] = PT < foo ? point_marker : B_ (current_buffer, mark); + args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark); varies[i] = 3; - args[++i] = PT > foo ? point_marker : B_ (current_buffer, mark); + args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark); varies[i] = 4; break; === modified file 'src/callproc.c' --- src/callproc.c 2011-02-14 15:39:19 +0000 +++ src/callproc.c 2011-02-16 15:02:50 +0000 @@ -265,7 +265,7 @@ if (nargs >= 2 && ! NILP (args[1])) { - infile = Fexpand_file_name (args[1], B_ (current_buffer, directory)); + infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory)); CHECK_STRING (infile); } else @@ -322,7 +322,7 @@ { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - current_dir = B_ (current_buffer, directory); + current_dir = BVAR (current_buffer, directory); GCPRO4 (infile, buffer, current_dir, error_file); @@ -336,7 +336,7 @@ if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (B_ (current_buffer, directory), Qnil)); + Fcons (BVAR (current_buffer, directory), Qnil)); if (STRING_MULTIBYTE (infile)) infile = ENCODE_FILE (infile); @@ -663,7 +663,7 @@ /* In unibyte mode, character code conversion should not take place but EOL conversion should. So, setup raw-text or one of the subsidiary according to the information just setup. */ - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && !NILP (val)) val = raw_text_coding_system (val); setup_coding_system (val, &process_coding); @@ -713,7 +713,7 @@ if (!NILP (buffer)) { - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) insert_1_both (buf, nread, nread, 0, 1, 0); else @@ -926,7 +926,7 @@ /* Decide coding-system of the contents of the temporary file. */ if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if (NILP (B_ (current_buffer, enable_multibyte_characters))) + else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) val = Qraw_text; else { === modified file 'src/casefiddle.c' --- src/casefiddle.c 2011-02-14 15:39:19 +0000 +++ src/casefiddle.c 2011-02-16 15:02:50 +0000 @@ -39,15 +39,15 @@ register int inword = flag == CASE_DOWN; /* If the case table is flagged as modified, rescan it. */ - if (NILP (XCHAR_TABLE (B_ (current_buffer, downcase_table))->extras[1])) - Fset_case_table (B_ (current_buffer, downcase_table)); + if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) + Fset_case_table (BVAR (current_buffer, downcase_table)); if (INTEGERP (obj)) { int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META); int flags = XINT (obj) & flagbits; - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); /* If the character has higher bits set above the flags, return it unchanged. @@ -198,7 +198,7 @@ { register int c; register int inword = flag == CASE_DOWN; - register int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + register int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); EMACS_INT start, end; EMACS_INT start_byte, end_byte; EMACS_INT first = -1, last; /* Position of first and last changes. */ @@ -210,8 +210,8 @@ return; /* If the case table is flagged as modified, rescan it. */ - if (NILP (XCHAR_TABLE (B_ (current_buffer, downcase_table))->extras[1])) - Fset_case_table (B_ (current_buffer, downcase_table)); + if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) + Fset_case_table (BVAR (current_buffer, downcase_table)); validate_region (&b, &e); start = XFASTINT (b); === modified file 'src/casetab.c' --- src/casetab.c 2011-02-14 15:39:19 +0000 +++ src/casetab.c 2011-02-16 15:02:50 +0000 @@ -71,7 +71,7 @@ doc: /* Return the case table of the current buffer. */) (void) { - return B_ (current_buffer, downcase_table); + return BVAR (current_buffer, downcase_table); } DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, @@ -160,10 +160,10 @@ } else { - B_ (current_buffer, downcase_table) = table; - B_ (current_buffer, upcase_table) = up; - B_ (current_buffer, case_canon_table) = canon; - B_ (current_buffer, case_eqv_table) = eqv; + BVAR (current_buffer, downcase_table) = table; + BVAR (current_buffer, upcase_table) = up; + BVAR (current_buffer, case_canon_table) = canon; + BVAR (current_buffer, case_eqv_table) = eqv; } return table; === modified file 'src/category.c' --- src/category.c 2011-02-14 15:39:19 +0000 +++ src/category.c 2011-02-16 15:02:50 +0000 @@ -190,7 +190,7 @@ check_category_table (Lisp_Object table) { if (NILP (table)) - return B_ (current_buffer, category_table); + return BVAR (current_buffer, category_table); CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table); return table; } @@ -200,7 +200,7 @@ This is the one specified by the current buffer. */) (void) { - return B_ (current_buffer, category_table); + return BVAR (current_buffer, category_table); } DEFUN ("standard-category-table", Fstandard_category_table, @@ -281,7 +281,7 @@ { int idx; table = check_category_table (table); - B_ (current_buffer, category_table) = table; + BVAR (current_buffer, category_table) = table; /* Indicate that this buffer now has a specified category table. */ idx = PER_BUFFER_VAR_IDX (category_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); @@ -292,7 +292,7 @@ Lisp_Object char_category_set (int c) { - return CHAR_TABLE_REF (B_ (current_buffer, category_table), c); + return CHAR_TABLE_REF (BVAR (current_buffer, category_table), c); } DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, === modified file 'src/category.h' --- src/category.h 2011-02-14 15:39:19 +0000 +++ src/category.h 2011-02-16 15:02:50 +0000 @@ -91,7 +91,7 @@ /* The standard category table is stored where it will automatically be used in all new buffers. */ -#define Vstandard_category_table B_ (&buffer_defaults, category_table) +#define Vstandard_category_table BVAR (&buffer_defaults, category_table) /* Return the category set of character C in the current category table. */ #define CATEGORY_SET(c) char_category_set (c) === modified file 'src/character.c' --- src/character.c 2011-02-14 15:39:19 +0000 +++ src/character.c 2011-02-16 15:02:50 +0000 @@ -521,7 +521,7 @@ { /* current_buffer is null at early stages of Emacs initialization. */ if (current_buffer == 0 - || NILP (B_ (current_buffer, enable_multibyte_characters))) + || NILP (BVAR (current_buffer, enable_multibyte_characters))) return nbytes; return multibyte_chars_in_text (ptr, nbytes); @@ -987,7 +987,7 @@ pos = XFASTINT (position); p = CHAR_POS_ADDR (pos); } - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return make_number (*p); } else === modified file 'src/character.h' --- src/character.h 2011-02-14 15:39:19 +0000 +++ src/character.h 2011-02-16 15:02:50 +0000 @@ -417,7 +417,7 @@ do \ { \ CHARIDX++; \ - if (!NILP (B_ (current_buffer, enable_multibyte_characters))) \ + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) \ { \ unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ int len; \ @@ -484,7 +484,7 @@ do \ { \ (charpos)++; \ - if (NILP (B_ (current_buffer, enable_multibyte_characters))) \ + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ (bytepos)++; \ else \ INC_POS ((bytepos)); \ @@ -498,7 +498,7 @@ do \ { \ (charpos)--; \ - if (NILP (B_ (current_buffer, enable_multibyte_characters))) \ + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ (bytepos)--; \ else \ DEC_POS ((bytepos)); \ @@ -561,11 +561,11 @@ #define ASCII_CHAR_WIDTH(c) \ (c < 0x20 \ ? (c == '\t' \ - ? XFASTINT (B_ (current_buffer, tab_width)) \ - : (c == '\n' ? 0 : (NILP (B_ (current_buffer, ctl_arrow)) ? 4 : 2))) \ + ? XFASTINT (BVAR (current_buffer, tab_width)) \ + : (c == '\n' ? 0 : (NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))) \ : (c < 0x7f \ ? 1 \ - : ((NILP (B_ (current_buffer, ctl_arrow)) ? 4 : 2)))) + : ((NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2)))) /* Return the width of character C. The width is measured by how many columns C will occupy on the screen when displayed in the current === modified file 'src/charset.c' --- src/charset.c 2011-02-14 15:39:19 +0000 +++ src/charset.c 2011-02-16 15:02:50 +0000 @@ -1554,7 +1554,7 @@ EMACS_INT from, from_byte, to, stop, stop_byte; int i; Lisp_Object val; - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); validate_region (&beg, &end); from = XFASTINT (beg); === modified file 'src/cmds.c' --- src/cmds.c 2011-02-14 15:39:19 +0000 +++ src/cmds.c 2011-02-16 15:02:50 +0000 @@ -292,10 +292,10 @@ } if (remove_boundary - && CONSP (B_ (current_buffer, undo_list)) - && NILP (XCAR (B_ (current_buffer, undo_list)))) + && CONSP (BVAR (current_buffer, undo_list)) + && NILP (XCAR (BVAR (current_buffer, undo_list)))) /* Remove the undo_boundary that was just pushed. */ - B_ (current_buffer, undo_list) = XCDR (B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = XCDR (BVAR (current_buffer, undo_list)); /* Barf if the key that invoked this was not a character. */ if (!CHARACTERP (last_command_event)) @@ -335,12 +335,12 @@ EMACS_INT chars_to_delete = 0; EMACS_INT spaces_to_insert = 0; - overwrite = B_ (current_buffer, overwrite_mode); + overwrite = BVAR (current_buffer, overwrite_mode); if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) hairy = 1; /* At first, get multi-byte form of C in STR. */ - if (!NILP (B_ (current_buffer, enable_multibyte_characters))) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { len = CHAR_STRING (c, str); if (len == 1) @@ -416,11 +416,11 @@ synt = SYNTAX (c); - if (!NILP (B_ (current_buffer, abbrev_mode)) + if (!NILP (BVAR (current_buffer, abbrev_mode)) && synt != Sword - && NILP (B_ (current_buffer, read_only)) + && NILP (BVAR (current_buffer, read_only)) && PT > BEGV - && (SYNTAX (!NILP (B_ (current_buffer, enable_multibyte_characters)) + && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters)) ? XFASTINT (Fprevious_char ()) : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) == Sword)) @@ -448,7 +448,7 @@ if (chars_to_delete) { - int mc = ((NILP (B_ (current_buffer, enable_multibyte_characters)) + int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters)) && SINGLE_BYTE_CHAR_P (c)) ? UNIBYTE_TO_CHAR (c) : c); Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); @@ -479,7 +479,7 @@ if ((CHAR_TABLE_P (Vauto_fill_chars) ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) : (c == ' ' || c == '\n')) - && !NILP (B_ (current_buffer, auto_fill_function))) + && !NILP (BVAR (current_buffer, auto_fill_function))) { Lisp_Object tem; @@ -488,7 +488,7 @@ that. Must have the newline in place already so filling and justification, if any, know where the end is going to be. */ SET_PT_BOTH (PT - 1, PT_BYTE - 1); - tem = call0 (B_ (current_buffer, auto_fill_function)); + tem = call0 (BVAR (current_buffer, auto_fill_function)); /* Test PT < ZV in case the auto-fill-function is strange. */ if (c == '\n' && PT < ZV) SET_PT_BOTH (PT + 1, PT_BYTE + 1); === modified file 'src/coding.c' --- src/coding.c 2011-02-14 15:39:19 +0000 +++ src/coding.c 2011-02-16 15:02:50 +0000 @@ -7038,8 +7038,8 @@ set_buffer_internal (XBUFFER (coding->dst_object)); if (GPT != PT) move_gap_both (PT, PT_BYTE); - undo_list = B_ (current_buffer, undo_list); - B_ (current_buffer, undo_list) = Qt; + undo_list = BVAR (current_buffer, undo_list); + BVAR (current_buffer, undo_list) = Qt; } coding->consumed = coding->consumed_char = 0; @@ -7136,7 +7136,7 @@ decode_eol (coding); if (BUFFERP (coding->dst_object)) { - B_ (current_buffer, undo_list) = undo_list; + BVAR (current_buffer, undo_list) = undo_list; record_insert (coding->dst_pos, coding->produced_char); } return coding->result; @@ -7433,7 +7433,7 @@ { set_buffer_internal (XBUFFER (coding->dst_object)); coding->dst_multibyte - = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); } coding->consumed = coding->consumed_char = 0; @@ -7504,8 +7504,8 @@ doesn't compile new regexps. */ Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); Ferase_buffer (); - B_ (current_buffer, undo_list) = Qt; - B_ (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil; + BVAR (current_buffer, undo_list) = Qt; + BVAR (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil; set_buffer_internal (current); return workbuf; } @@ -7562,7 +7562,7 @@ coding->dst_object = coding->src_object; coding->dst_pos = PT; coding->dst_pos_byte = PT_BYTE; - coding->dst_multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + coding->dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); if (CODING_REQUIRE_DETECTION (coding)) detect_coding (coding); @@ -7728,7 +7728,7 @@ coding->dst_pos = BUF_PT (XBUFFER (dst_object)); coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object)); coding->dst_multibyte - = ! NILP (B_ (XBUFFER (dst_object), enable_multibyte_characters)); + = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters)); } else { @@ -7798,7 +7798,7 @@ TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); else if (saved_pt < from + chars) TEMP_SET_PT_BOTH (from, from_byte); - else if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + else if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), saved_pt_byte + (coding->produced - bytes)); else @@ -7822,7 +7822,7 @@ { tail->bytepos = from_byte + coding->produced; tail->charpos - = (NILP (B_ (current_buffer, enable_multibyte_characters)) + = (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? tail->bytepos : from + coding->produced_char); } } @@ -7960,7 +7960,7 @@ set_buffer_temp (current); } coding->dst_multibyte - = ! NILP (B_ (XBUFFER (dst_object), enable_multibyte_characters)); + = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters)); } else if (EQ (dst_object, Qt)) { @@ -8003,7 +8003,7 @@ TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); else if (saved_pt < from + chars) TEMP_SET_PT_BOTH (from, from_byte); - else if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + else if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), saved_pt_byte + (coding->produced - bytes)); else @@ -8027,7 +8027,7 @@ { tail->bytepos = from_byte + coding->produced; tail->charpos - = (NILP (B_ (current_buffer, enable_multibyte_characters)) + = (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? tail->bytepos : from + coding->produced_char); } } @@ -8481,7 +8481,7 @@ return detect_coding_system (BYTE_POS_ADDR (from_byte), to - from, to_byte - from_byte, !NILP (highest), - !NILP (B_ (current_buffer + !NILP (BVAR (current_buffer , enable_multibyte_characters)), Qnil); } @@ -8564,7 +8564,7 @@ CHECK_NUMBER_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qt; start_byte = CHAR_TO_BYTE (XINT (start)); end_byte = CHAR_TO_BYTE (XINT (end)); @@ -8698,7 +8698,7 @@ validate_region (&start, &end); from = XINT (start); to = XINT (end); - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || (ascii_compatible && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from))))) return Qnil; @@ -8814,7 +8814,7 @@ CHECK_NUMBER_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qnil; start_byte = CHAR_TO_BYTE (XINT (start)); end_byte = CHAR_TO_BYTE (XINT (end)); === modified file 'src/composite.c' --- src/composite.c 2011-02-14 15:39:19 +0000 +++ src/composite.c 2011-02-16 15:02:50 +0000 @@ -796,7 +796,7 @@ if (NILP (string)) { - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) error ("Attempt to shape unibyte text"); validate_region (&start, &end); from = XFASTINT (start); @@ -1028,7 +1028,7 @@ cmp_it->stop_pos = endpos = start; cmp_it->ch = -1; } - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || NILP (Vauto_composition_mode)) return; if (bytepos < 0) @@ -1674,7 +1674,7 @@ return new_pt; } - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || NILP (Vauto_composition_mode)) return new_pt; @@ -1851,7 +1851,7 @@ if (!find_composition (from, to, &start, &end, &prop, string)) { - if (!NILP (B_ (current_buffer, enable_multibyte_characters)) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! NILP (Vauto_composition_mode) && find_automatic_composition (from, to, &start, &end, &gstring, string)) === modified file 'src/data.c' --- src/data.c 2011-02-14 15:39:19 +0000 +++ src/data.c 2011-02-16 15:02:50 +0000 @@ -1009,7 +1009,7 @@ } else { - tem1 = assq_no_quit (var, B_ (current_buffer, local_var_alist)); + tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); XSETBUFFER (blv->where, current_buffer); } } @@ -1178,7 +1178,7 @@ tem1 = Fassq (symbol, (blv->frame_local ? XFRAME (where)->param_alist - : B_ (XBUFFER (where), local_var_alist))); + : BVAR (XBUFFER (where), local_var_alist))); blv->where = where; blv->found = 1; @@ -1209,8 +1209,8 @@ bindings, not for frame-local bindings. */ eassert (!blv->frame_local); tem1 = Fcons (symbol, XCDR (blv->defcell)); - B_ (XBUFFER (where), local_var_alist) - = Fcons (tem1, B_ (XBUFFER (where), local_var_alist)); + BVAR (XBUFFER (where), local_var_alist) + = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); } } @@ -1632,13 +1632,13 @@ if (let_shadows_global_binding_p (symbol)) message ("Making %s local to %s while let-bound!", SDATA (SYMBOL_NAME (variable)), - SDATA (B_ (current_buffer, name))); + SDATA (BVAR (current_buffer, name))); } } /* Make sure this buffer has its own value of symbol. */ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - tem = Fassq (variable, B_ (current_buffer, local_var_alist)); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { if (let_shadows_buffer_binding_p (sym)) @@ -1650,9 +1650,9 @@ default value. */ find_symbol_value (variable); - B_ (current_buffer, local_var_alist) + BVAR (current_buffer, local_var_alist) = Fcons (Fcons (variable, XCDR (blv->defcell)), - B_ (current_buffer, local_var_alist)); + BVAR (current_buffer, local_var_alist)); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value. */ @@ -1718,10 +1718,10 @@ /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ - tem = Fassq (variable, B_ (current_buffer, local_var_alist)); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) - B_ (current_buffer, local_var_alist) - = Fdelq (tem, B_ (current_buffer, local_var_alist)); + BVAR (current_buffer, local_var_alist) + = Fdelq (tem, BVAR (current_buffer, local_var_alist)); /* If the symbol is set up with the current buffer's binding loaded, recompute its value. We have to do it now, or else @@ -1848,7 +1848,7 @@ XSETBUFFER (tmp, buf); XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - for (tail = B_ (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); if (EQ (variable, XCAR (elt))) === modified file 'src/dired.c' --- src/dired.c 2011-02-14 17:35:21 +0000 +++ src/dired.c 2011-02-16 15:02:50 +0000 @@ -158,7 +158,7 @@ # ifdef WINDOWSNT /* Windows users want case-insensitive wildcards. */ bufp = compile_pattern (match, 0, - B_ (&buffer_defaults, case_canon_table), 0, 1); + BVAR (&buffer_defaults, case_canon_table), 0, 1); # else /* !WINDOWSNT */ bufp = compile_pattern (match, 0, Qnil, 0, 1); # endif /* !WINDOWSNT */ === modified file 'src/dispextern.h' --- src/dispextern.h 2011-02-14 15:39:19 +0000 +++ src/dispextern.h 2011-02-16 15:02:50 +0000 @@ -1416,7 +1416,7 @@ && !(W)->pseudo_window_p \ && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ && BUFFERP ((W)->buffer) \ - && !NILP (B_ (XBUFFER ((W)->buffer), mode_line_format)) \ + && !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format)) \ && WINDOW_TOTAL_LINES (W) > 1) /* Value is non-zero if window W wants a header line. */ @@ -1426,8 +1426,8 @@ && !(W)->pseudo_window_p \ && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ && BUFFERP ((W)->buffer) \ - && !NILP (B_ (XBUFFER ((W)->buffer), header_line_format)) \ - && WINDOW_TOTAL_LINES (W) > 1 + !NILP (B_ (XBUFFER ((W)->buffer), mode_line_format))) + && !NILP (BVAR (XBUFFER ((W)->buffer), header_line_format)) \ + && WINDOW_TOTAL_LINES (W) > 1 + !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format))) /* Return proper value to be used as baseline offset of font that has === modified file 'src/dispnew.c' --- src/dispnew.c 2011-02-14 15:39:19 +0000 +++ src/dispnew.c 2011-02-16 15:02:50 +0000 @@ -6129,7 +6129,7 @@ { buf = XCDR (XCAR (tail)); /* Ignore buffers that aren't included in buffer lists. */ - if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') + if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') continue; if (vecp == end) goto changed; @@ -6137,7 +6137,7 @@ goto changed; if (vecp == end) goto changed; - if (!EQ (*vecp++, B_ (XBUFFER (buf), read_only))) + if (!EQ (*vecp++, BVAR (XBUFFER (buf), read_only))) goto changed; if (vecp == end) goto changed; @@ -6184,10 +6184,10 @@ { buf = XCDR (XCAR (tail)); /* Ignore buffers that aren't included in buffer lists. */ - if (SREF (B_ (XBUFFER (buf), name), 0) == ' ') + if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') continue; *vecp++ = buf; - *vecp++ = B_ (XBUFFER (buf), read_only); + *vecp++ = BVAR (XBUFFER (buf), read_only); *vecp++ = Fbuffer_modified_p (buf); } /* Fill up the vector with lambdas (always at least one). */ === modified file 'src/editfns.c' --- src/editfns.c 2011-02-14 15:39:19 +0000 +++ src/editfns.c 2011-02-16 15:02:50 +0000 @@ -306,10 +306,10 @@ if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) - && NILP (B_ (current_buffer, mark_active))) + && NILP (BVAR (current_buffer, mark_active))) xsignal0 (Qmark_inactive); - m = Fmarker_position (B_ (current_buffer, mark)); + m = Fmarker_position (BVAR (current_buffer, mark)); if (NILP (m)) error ("The mark is not set now, so there is no region"); @@ -338,7 +338,7 @@ If you set the marker not to point anywhere, the buffer will have no mark. */) (void) { - return B_ (current_buffer, mark); + return BVAR (current_buffer, mark); } @@ -866,9 +866,9 @@ == current_buffer); return Fcons (Fpoint_marker (), - Fcons (Fcopy_marker (B_ (current_buffer, mark), Qnil), + Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil), Fcons (visible ? Qt : Qnil, - Fcons (B_ (current_buffer, mark_active), + Fcons (BVAR (current_buffer, mark_active), selected_window)))); } @@ -900,8 +900,8 @@ /* Mark marker. */ info = XCDR (info); tem = XCAR (info); - omark = Fmarker_position (B_ (current_buffer, mark)); - Fset_marker (B_ (current_buffer, mark), tem, Fcurrent_buffer ()); + omark = Fmarker_position (BVAR (current_buffer, mark)); + Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ()); nmark = Fmarker_position (tem); unchain_marker (XMARKER (tem)); @@ -922,14 +922,14 @@ /* Mark active */ info = XCDR (info); tem = XCAR (info); - tem1 = B_ (current_buffer, mark_active); - B_ (current_buffer, mark_active) = tem; + tem1 = BVAR (current_buffer, mark_active); + BVAR (current_buffer, mark_active) = tem; if (!NILP (Vrun_hooks)) { /* If mark is active now, and either was not active or was at a different place, run the activate hook. */ - if (! NILP (B_ (current_buffer, mark_active))) + if (! NILP (BVAR (current_buffer, mark_active))) { if (! EQ (omark, nmark)) call1 (Vrun_hooks, intern ("activate-mark-hook")); @@ -1114,7 +1114,7 @@ Lisp_Object temp; if (PT <= BEGV) XSETFASTINT (temp, 0); - else if (!NILP (B_ (current_buffer, enable_multibyte_characters))) + else if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { EMACS_INT pos = PT_BYTE; DEC_POS (pos); @@ -1228,7 +1228,7 @@ pos_byte = CHAR_TO_BYTE (XINT (pos)); } - if (!NILP (B_ (current_buffer, enable_multibyte_characters))) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { DEC_POS (pos_byte); XSETFASTINT (val, FETCH_CHAR (pos_byte)); @@ -2135,7 +2135,7 @@ unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; - if (!NILP (B_ (current_buffer, enable_multibyte_characters))) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (XFASTINT (val), str); else { @@ -2267,7 +2267,7 @@ CHECK_NUMBER (character); CHECK_NUMBER (count); - if (!NILP (B_ (current_buffer, enable_multibyte_characters))) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (XFASTINT (character), str); else str[0] = XFASTINT (character), len = 1; @@ -2316,7 +2316,7 @@ if (XINT (byte) < 0 || XINT (byte) > 255) args_out_of_range_3 (byte, make_number (0), make_number (255)); if (XINT (byte) >= 128 - && ! NILP (B_ (current_buffer, enable_multibyte_characters))) + && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); return Finsert_char (byte, count, inherit); } @@ -2370,7 +2370,7 @@ if (start < GPT && GPT < end) move_gap (start); - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) result = make_uninit_multibyte_string (end - start, end_byte - start_byte); else result = make_uninit_string (end - start); @@ -2485,7 +2485,7 @@ if (NILP (buf)) nsberror (buffer); bp = XBUFFER (buf); - if (NILP (B_ (bp, name))) + if (NILP (BVAR (bp, name))) error ("Selecting deleted buffer"); if (NILP (start)) @@ -2533,8 +2533,8 @@ register EMACS_INT begp1, endp1, begp2, endp2, temp; register struct buffer *bp1, *bp2; register Lisp_Object trt - = (!NILP (B_ (current_buffer, case_fold_search)) - ? B_ (current_buffer, case_canon_table) : Qnil); + = (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil); EMACS_INT chars = 0; EMACS_INT i1, i2, i1_byte, i2_byte; @@ -2549,7 +2549,7 @@ if (NILP (buf1)) nsberror (buffer1); bp1 = XBUFFER (buf1); - if (NILP (B_ (bp1, name))) + if (NILP (BVAR (bp1, name))) error ("Selecting deleted buffer"); } @@ -2587,7 +2587,7 @@ if (NILP (buf2)) nsberror (buffer2); bp2 = XBUFFER (buf2); - if (NILP (B_ (bp2, name))) + if (NILP (BVAR (bp2, name))) error ("Selecting deleted buffer"); } @@ -2627,7 +2627,7 @@ QUIT; - if (! NILP (B_ (bp1, enable_multibyte_characters))) + if (! NILP (BVAR (bp1, enable_multibyte_characters))) { c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); BUF_INC_POS (bp1, i1_byte); @@ -2640,7 +2640,7 @@ i1++; } - if (! NILP (B_ (bp2, enable_multibyte_characters))) + if (! NILP (BVAR (bp2, enable_multibyte_characters))) { c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte); BUF_INC_POS (bp2, i2_byte); @@ -2680,13 +2680,13 @@ static Lisp_Object subst_char_in_region_unwind (Lisp_Object arg) { - return B_ (current_buffer, undo_list) = arg; + return BVAR (current_buffer, undo_list) = arg; } static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object arg) { - return B_ (current_buffer, filename) = arg; + return BVAR (current_buffer, filename) = arg; } DEFUN ("subst-char-in-region", Fsubst_char_in_region, @@ -2712,7 +2712,7 @@ #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) int maybe_byte_combining = COMBINING_NO; EMACS_INT last_changed = 0; - int multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); restart: @@ -2756,12 +2756,12 @@ if (!changed && !NILP (noundo)) { record_unwind_protect (subst_char_in_region_unwind, - B_ (current_buffer, undo_list)); - B_ (current_buffer, undo_list) = Qt; + BVAR (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = Qt; /* Don't do file-locking. */ record_unwind_protect (subst_char_in_region_unwind_1, - B_ (current_buffer, filename)); - B_ (current_buffer, filename) = Qnil; + BVAR (current_buffer, filename)); + BVAR (current_buffer, filename) = Qnil; } if (pos_byte < GPT_BYTE) @@ -2824,7 +2824,7 @@ struct gcpro gcpro1; - tem = B_ (current_buffer, undo_list); + tem = BVAR (current_buffer, undo_list); GCPRO1 (tem); /* Make a multibyte string containing this single character. */ @@ -2843,7 +2843,7 @@ INC_POS (pos_byte_next); if (! NILP (noundo)) - B_ (current_buffer, undo_list) = tem; + BVAR (current_buffer, undo_list) = tem; UNGCPRO; } @@ -2945,7 +2945,7 @@ int cnt; /* Number of changes made. */ EMACS_INT size; /* Size of translate table. */ EMACS_INT pos, pos_byte, end_pos; - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); int string_multibyte; Lisp_Object val; @@ -3206,7 +3206,7 @@ ? XMARKER (XCAR (data))->buffer : XBUFFER (data)); - if (buf && buf != current_buffer && !NILP (B_ (buf, pt_marker))) + if (buf && buf != current_buffer && !NILP (BVAR (buf, pt_marker))) { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as is the case if it is or has an indirect buffer), then make sure it is current before we update BEGV, so @@ -4136,20 +4136,20 @@ if (XINT (c1) == XINT (c2)) return Qt; - if (NILP (B_ (current_buffer, case_fold_search))) + if (NILP (BVAR (current_buffer, case_fold_search))) return Qnil; /* Do these in separate statements, then compare the variables. because of the way DOWNCASE uses temp variables. */ i1 = XFASTINT (c1); - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! ASCII_CHAR_P (i1)) { MAKE_CHAR_MULTIBYTE (i1); } i2 = XFASTINT (c2); - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! ASCII_CHAR_P (i2)) { MAKE_CHAR_MULTIBYTE (i2); === modified file 'src/fileio.c' --- src/fileio.c 2011-02-14 17:35:21 +0000 +++ src/fileio.c 2011-02-16 15:02:50 +0000 @@ -770,7 +770,7 @@ /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ if (NILP (default_directory)) - default_directory = B_ (current_buffer, directory); + default_directory = BVAR (current_buffer, directory); if (! STRINGP (default_directory)) { #ifdef DOS_NT @@ -2669,7 +2669,7 @@ struct stat st; Lisp_Object handler; - absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2722,7 +2722,7 @@ struct stat st; Lisp_Object handler; - absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2769,7 +2769,7 @@ context_t context; #endif - absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2827,7 +2827,7 @@ context_t parsed_con; #endif - absname = Fexpand_file_name (filename, B_ (current_buffer, directory)); + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2894,7 +2894,7 @@ struct stat st; Lisp_Object handler; - absname = expand_and_dir_to_file (filename, B_ (current_buffer, directory)); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2923,7 +2923,7 @@ Lisp_Object absname, encoded_absname; Lisp_Object handler; - absname = Fexpand_file_name (filename, B_ (current_buffer, directory)); + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); CHECK_NUMBER (mode); /* If the file name has special constructs in it, @@ -2985,7 +2985,7 @@ if (! lisp_time_argument (time, &sec, &usec)) error ("Invalid time specification"); - absname = Fexpand_file_name (filename, B_ (current_buffer, directory)); + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -3047,8 +3047,8 @@ absname1 = Qnil; GCPRO2 (absname1, file2); - absname1 = expand_and_dir_to_file (file1, B_ (current_buffer, directory)); - absname2 = expand_and_dir_to_file (file2, B_ (current_buffer, directory)); + absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory)); + absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory)); UNGCPRO; /* If the file name has special constructs in it, @@ -3116,8 +3116,8 @@ TEMP_SET_PT_BOTH (BEG, BEG_BYTE); /* Now we are safe to change the buffer's multibyteness directly. */ - B_ (current_buffer, enable_multibyte_characters) = multibyte; - B_ (current_buffer, undo_list) = undo_list; + BVAR (current_buffer, enable_multibyte_characters) = multibyte; + BVAR (current_buffer, undo_list) = undo_list; return Qnil; } @@ -3212,7 +3212,7 @@ if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); - if (!NILP (B_ (current_buffer, read_only))) + if (!NILP (BVAR (current_buffer, read_only))) Fbarf_if_buffer_read_only (); val = Qnil; @@ -3403,16 +3403,16 @@ buf = XBUFFER (buffer); delete_all_overlays (buf); - B_ (buf, directory) = B_ (current_buffer, directory); - B_ (buf, read_only) = Qnil; - B_ (buf, filename) = Qnil; - B_ (buf, undo_list) = Qt; + BVAR (buf, directory) = BVAR (current_buffer, directory); + BVAR (buf, read_only) = Qnil; + BVAR (buf, filename) = Qnil; + BVAR (buf, undo_list) = Qt; eassert (buf->overlays_before == NULL); eassert (buf->overlays_after == NULL); set_buffer_internal (buf); Ferase_buffer (); - B_ (buf, enable_multibyte_characters) = Qnil; + BVAR (buf, enable_multibyte_characters) = Qnil; insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -3450,7 +3450,7 @@ else CHECK_CODING_SYSTEM (coding_system); - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) /* We must suppress all character code conversion except for end-of-line conversion. */ coding_system = raw_text_coding_system (coding_system); @@ -3598,7 +3598,7 @@ we cannot use this method; giveup and try the other. */ if (same_at_end > same_at_start && FETCH_BYTE (same_at_end - 1) >= 0200 - && ! NILP (B_ (current_buffer, enable_multibyte_characters)) + && ! NILP (BVAR (current_buffer, enable_multibyte_characters)) && (CODING_MAY_REQUIRE_DECODING (&coding))) giveup_match_end = 1; break; @@ -3617,14 +3617,14 @@ /* Extend the start of non-matching text area to multibyte character boundary. */ - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_start > BEGV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) same_at_start--; /* Extend the end of non-matching text area to multibyte character boundary. */ - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_end < ZV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) same_at_end++; @@ -3673,7 +3673,7 @@ unsigned char *decoded; EMACS_INT temp; int this_count = SPECPDL_INDEX (); - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); Lisp_Object conversion_buffer; conversion_buffer = code_conversion_save (1, multibyte); @@ -3778,7 +3778,7 @@ /* Extend the start of non-matching text area to the previous multibyte character boundary. */ - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_start > BEGV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) same_at_start--; @@ -3795,7 +3795,7 @@ /* Extend the end of non-matching text area to the next multibyte character boundary. */ - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_end < ZV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) same_at_end++; @@ -3870,9 +3870,9 @@ if (NILP (visit) && inserted > 0) { #ifdef CLASH_DETECTION - if (!NILP (B_ (current_buffer, file_truename)) + if (!NILP (BVAR (current_buffer, file_truename)) /* Make binding buffer-file-name to nil effective. */ - && !NILP (B_ (current_buffer, filename)) + && !NILP (BVAR (current_buffer, filename)) && SAVE_MODIFF >= MODIFF) we_locked_file = 1; #endif /* CLASH_DETECTION */ @@ -3977,7 +3977,7 @@ { #ifdef CLASH_DETECTION if (we_locked_file) - unlock_file (B_ (current_buffer, file_truename)); + unlock_file (BVAR (current_buffer, file_truename)); #endif Vdeactivate_mark = old_Vdeactivate_mark; } @@ -4028,11 +4028,11 @@ Lisp_Object unwind_data; int count = SPECPDL_INDEX (); - unwind_data = Fcons (B_ (current_buffer, enable_multibyte_characters), - Fcons (B_ (current_buffer, undo_list), + unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters), + Fcons (BVAR (current_buffer, undo_list), Fcurrent_buffer ())); - B_ (current_buffer, enable_multibyte_characters) = Qnil; - B_ (current_buffer, undo_list) = Qt; + BVAR (current_buffer, enable_multibyte_characters) = Qnil; + BVAR (current_buffer, undo_list) = Qt; record_unwind_protect (decide_coding_unwind, unwind_data); if (inserted > 0 && ! NILP (Vset_auto_coding_function)) @@ -4062,7 +4062,7 @@ else CHECK_CODING_SYSTEM (coding_system); - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) /* We must suppress all character code conversion except for end-of-line conversion. */ coding_system = raw_text_coding_system (coding_system); @@ -4080,10 +4080,10 @@ && NILP (replace)) /* Visiting a file with these coding system makes the buffer unibyte. */ - B_ (current_buffer, enable_multibyte_characters) = Qnil; + BVAR (current_buffer, enable_multibyte_characters) = Qnil; } - coding.dst_multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); if (CODING_MAY_REQUIRE_DECODING (&coding) && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding))) { @@ -4110,9 +4110,9 @@ if ((VECTORP (CODING_ID_EOL_TYPE (coding.id)) || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)) && ! CODING_REQUIRE_DECODING (&coding)) - B_ (current_buffer, buffer_file_type) = Qt; + BVAR (current_buffer, buffer_file_type) = Qt; else - B_ (current_buffer, buffer_file_type) = Qnil; + BVAR (current_buffer, buffer_file_type) = Qnil; #endif handled: @@ -4124,24 +4124,24 @@ if (!NILP (visit)) { - if (!EQ (B_ (current_buffer, undo_list), Qt) && !nochange) - B_ (current_buffer, undo_list) = Qnil; + if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange) + BVAR (current_buffer, undo_list) = Qnil; if (NILP (handler)) { current_buffer->modtime = st.st_mtime; current_buffer->modtime_size = st.st_size; - B_ (current_buffer, filename) = orig_filename; + BVAR (current_buffer, filename) = orig_filename; } SAVE_MODIFF = MODIFF; BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; - XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); #ifdef CLASH_DETECTION if (NILP (handler)) { - if (!NILP (B_ (current_buffer, file_truename))) - unlock_file (B_ (current_buffer, file_truename)); + if (!NILP (BVAR (current_buffer, file_truename))) + unlock_file (BVAR (current_buffer, file_truename)); unlock_file (filename); } #endif /* CLASH_DETECTION */ @@ -4174,8 +4174,8 @@ specbind (Qinhibit_modification_hooks, Qt); /* Save old undo list and don't record undo for decoding. */ - old_undo = B_ (current_buffer, undo_list); - B_ (current_buffer, undo_list) = Qt; + old_undo = BVAR (current_buffer, undo_list); + BVAR (current_buffer, undo_list) = Qt; if (NILP (replace)) { @@ -4263,7 +4263,7 @@ if (NILP (visit)) { - B_ (current_buffer, undo_list) = old_undo; + BVAR (current_buffer, undo_list) = old_undo; if (CONSP (old_undo) && inserted != old_inserted) { /* Adjust the last undo record for the size change during @@ -4278,7 +4278,7 @@ else /* If undo_list was Qt before, keep it that way. Otherwise start with an empty undo_list. */ - B_ (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil; + BVAR (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil; unbind_to (count, Qnil); } @@ -4332,8 +4332,8 @@ Lisp_Object eol_parent = Qnil; if (auto_saving - && NILP (Fstring_equal (B_ (current_buffer, filename), - B_ (current_buffer, auto_save_file_name)))) + && NILP (Fstring_equal (BVAR (current_buffer, filename), + BVAR (current_buffer, auto_save_file_name)))) { val = Qutf_8_emacs; eol_parent = Qunix; @@ -4362,12 +4362,12 @@ int using_default_coding = 0; int force_raw_text = 0; - val = B_ (current_buffer, buffer_file_coding_system); + val = BVAR (current_buffer, buffer_file_coding_system); if (NILP (val) || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) { val = Qnil; - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) force_raw_text = 1; } @@ -4388,7 +4388,7 @@ { /* If we still have not decided a coding system, use the default value of buffer-file-coding-system. */ - val = B_ (current_buffer, buffer_file_coding_system); + val = BVAR (current_buffer, buffer_file_coding_system); using_default_coding = 1; } @@ -4412,9 +4412,9 @@ format, we use that of `default-buffer-file-coding-system'. */ if (! using_default_coding - && ! NILP (B_ (&buffer_defaults, buffer_file_coding_system))) + && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system))) val = (coding_inherit_eol_type - (val, B_ (&buffer_defaults, buffer_file_coding_system))); + (val, BVAR (&buffer_defaults, buffer_file_coding_system))); /* If we decide not to encode text, use `raw-text' or one of its subsidiaries. */ @@ -4425,7 +4425,7 @@ val = coding_inherit_eol_type (val, eol_parent); setup_coding_system (val, coding); - if (!STRINGP (start) && !NILP (B_ (current_buffer, selective_display))) + if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display))) coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; return val; } @@ -4529,8 +4529,8 @@ if (visiting) { SAVE_MODIFF = MODIFF; - XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); - B_ (current_buffer, filename) = visit_file; + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); + BVAR (current_buffer, filename) = visit_file; } UNGCPRO; return val; @@ -4743,15 +4743,15 @@ if (visiting) { SAVE_MODIFF = MODIFF; - XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); - B_ (current_buffer, filename) = visit_file; + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); + BVAR (current_buffer, filename) = visit_file; update_mode_lines++; } else if (quietly) { if (auto_saving - && ! NILP (Fstring_equal (B_ (current_buffer, filename), - B_ (current_buffer, auto_save_file_name)))) + && ! NILP (Fstring_equal (BVAR (current_buffer, filename), + BVAR (current_buffer, auto_save_file_name)))) SAVE_MODIFF = MODIFF; return Qnil; @@ -4833,10 +4833,10 @@ } /* Now do the same for annotation functions implied by the file-format */ - if (auto_saving && (!EQ (B_ (current_buffer, auto_save_file_format), Qt))) - p = B_ (current_buffer, auto_save_file_format); + if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt))) + p = BVAR (current_buffer, auto_save_file_format); else - p = B_ (current_buffer, file_format); + p = BVAR (current_buffer, file_format); for (i = 0; CONSP (p); p = XCDR (p), ++i) { struct buffer *given_buffer = current_buffer; @@ -5015,17 +5015,17 @@ b = XBUFFER (buf); } - if (!STRINGP (B_ (b, filename))) return Qt; + if (!STRINGP (BVAR (b, filename))) return Qt; if (b->modtime == 0) return Qt; /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (B_ (b, filename), + handler = Ffind_file_name_handler (BVAR (b, filename), Qverify_visited_file_modtime); if (!NILP (handler)) return call2 (handler, Qverify_visited_file_modtime, buf); - filename = ENCODE_FILE (B_ (b, filename)); + filename = ENCODE_FILE (BVAR (b, filename)); if (stat (SSDATA (filename), &st) < 0) { @@ -5093,7 +5093,7 @@ struct stat st; Lisp_Object handler; - filename = Fexpand_file_name (B_ (current_buffer, filename), Qnil); + filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -5128,7 +5128,7 @@ ring_bell (XFRAME (selected_frame)); args[0] = build_string ("Auto-saving %s: %s"); - args[1] = B_ (current_buffer, name); + args[1] = BVAR (current_buffer, name); args[2] = Ferror_message_string (error); msg = Fformat (3, args); GCPRO1 (msg); @@ -5159,19 +5159,19 @@ auto_save_mode_bits = 0666; /* Get visited file's mode to become the auto save file's mode. */ - if (! NILP (B_ (current_buffer, filename))) + if (! NILP (BVAR (current_buffer, filename))) { - if (stat (SSDATA (B_ (current_buffer, filename)), &st) >= 0) + if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = st.st_mode | 0600; - else if ((modes = Ffile_modes (B_ (current_buffer, filename)), + else if ((modes = Ffile_modes (BVAR (current_buffer, filename)), INTEGERP (modes))) /* Remote files don't cooperate with stat. */ auto_save_mode_bits = XINT (modes) | 0600; } return - Fwrite_region (Qnil, Qnil, B_ (current_buffer, auto_save_file_name), Qnil, + Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil, NILP (Vauto_save_visited_file_name) ? Qlambda : Qt, Qnil, Qnil); } @@ -5312,18 +5312,18 @@ /* Record all the buffers that have auto save mode in the special file that lists them. For each of these buffers, Record visited name (if any) and auto save name. */ - if (STRINGP (B_ (b, auto_save_file_name)) + if (STRINGP (BVAR (b, auto_save_file_name)) && stream != NULL && do_handled_files == 0) { BLOCK_INPUT; - if (!NILP (B_ (b, filename))) + if (!NILP (BVAR (b, filename))) { - fwrite (SDATA (B_ (b, filename)), 1, - SBYTES (B_ (b, filename)), stream); + fwrite (SDATA (BVAR (b, filename)), 1, + SBYTES (BVAR (b, filename)), stream); } putc ('\n', stream); - fwrite (SDATA (B_ (b, auto_save_file_name)), 1, - SBYTES (B_ (b, auto_save_file_name)), stream); + fwrite (SDATA (BVAR (b, auto_save_file_name)), 1, + SBYTES (BVAR (b, auto_save_file_name)), stream); putc ('\n', stream); UNBLOCK_INPUT; } @@ -5340,13 +5340,13 @@ /* Check for auto save enabled and file changed since last auto save and file changed since last real save. */ - if (STRINGP (B_ (b, auto_save_file_name)) + if (STRINGP (BVAR (b, auto_save_file_name)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ - && XINT (B_ (b, save_length)) >= 0 + && XINT (BVAR (b, save_length)) >= 0 && (do_handled_files - || NILP (Ffind_file_name_handler (B_ (b, auto_save_file_name), + || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name), Qwrite_region)))) { EMACS_TIME before_time, after_time; @@ -5360,23 +5360,23 @@ set_buffer_internal (b); if (NILP (Vauto_save_include_big_deletions) - && (XFASTINT (B_ (b, save_length)) * 10 + && (XFASTINT (BVAR (b, save_length)) * 10 > (BUF_Z (b) - BUF_BEG (b)) * 13) /* A short file is likely to change a large fraction; spare the user annoying messages. */ - && XFASTINT (B_ (b, save_length)) > 5000 + && XFASTINT (BVAR (b, save_length)) > 5000 /* These messages are frequent and annoying for `*mail*'. */ - && !EQ (B_ (b, filename), Qnil) + && !EQ (BVAR (b, filename), Qnil) && NILP (no_message)) { /* It has shrunk too much; turn off auto-saving here. */ minibuffer_auto_raise = orig_minibuffer_auto_raise; message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save", - B_ (b, name), 1); + BVAR (b, name), 1); minibuffer_auto_raise = 0; /* Turn off auto-saving until there's a real save, and prevent any more warnings. */ - XSETINT (B_ (b, save_length), -1); + XSETINT (BVAR (b, save_length), -1); Fsleep_for (make_number (1), Qnil); continue; } @@ -5385,7 +5385,7 @@ internal_condition_case (auto_save_1, Qt, auto_save_error); auto_saved++; BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b); - XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); set_buffer_internal (old); EMACS_GET_TIME (after_time); @@ -5432,7 +5432,7 @@ /* FIXME: This should not be called in indirect buffers, since they're not autosaved. */ BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; - XSETFASTINT (B_ (current_buffer, save_length), Z - BEG); + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); current_buffer->auto_save_failure_time = -1; return Qnil; } === modified file 'src/filelock.c' --- src/filelock.c 2011-02-14 15:39:19 +0000 +++ src/filelock.c 2011-02-16 15:02:50 +0000 @@ -637,9 +637,9 @@ for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { b = XBUFFER (XCDR (XCAR (tail))); - if (STRINGP (B_ (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) + if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) { - unlock_file(B_ (b, file_truename)); + unlock_file(BVAR (b, file_truename)); } } } @@ -652,7 +652,7 @@ (Lisp_Object file) { if (NILP (file)) - file = B_ (current_buffer, file_truename); + file = BVAR (current_buffer, file_truename); else CHECK_STRING (file); if (SAVE_MODIFF < MODIFF @@ -669,8 +669,8 @@ (void) { if (SAVE_MODIFF < MODIFF - && STRINGP (B_ (current_buffer, file_truename))) - unlock_file (B_ (current_buffer, file_truename)); + && STRINGP (BVAR (current_buffer, file_truename))) + unlock_file (BVAR (current_buffer, file_truename)); return Qnil; } @@ -680,8 +680,8 @@ unlock_buffer (struct buffer *buffer) { if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) - && STRINGP (B_ (buffer, file_truename))) - unlock_file (B_ (buffer, file_truename)); + && STRINGP (BVAR (buffer, file_truename))) + unlock_file (BVAR (buffer, file_truename)); } DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, === modified file 'src/fns.c' --- src/fns.c 2011-02-14 15:39:19 +0000 +++ src/fns.c 2011-02-16 15:02:50 +0000 @@ -2984,7 +2984,7 @@ SAFE_ALLOCA (encoded, char *, allength); encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg), encoded, length, NILP (no_line_break), - !NILP (B_ (current_buffer, enable_multibyte_characters))); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); if (encoded_length > allength) abort (); @@ -3166,7 +3166,7 @@ EMACS_INT old_pos = PT; EMACS_INT decoded_length; EMACS_INT inserted_chars; - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); USE_SAFE_ALLOCA; validate_region (&beg, &end); @@ -4684,12 +4684,12 @@ { int force_raw_text = 0; - coding_system = B_ (XBUFFER (object), buffer_file_coding_system); + coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); if (NILP (coding_system) || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) { coding_system = Qnil; - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) force_raw_text = 1; } @@ -4706,11 +4706,11 @@ } if (NILP (coding_system) - && !NILP (B_ (XBUFFER (object), buffer_file_coding_system))) + && !NILP (BVAR (XBUFFER (object), buffer_file_coding_system))) { /* If we still have not decided a coding system, use the default value of buffer-file-coding-system. */ - coding_system = B_ (XBUFFER (object), buffer_file_coding_system); + coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); } if (!force_raw_text === modified file 'src/font.c' --- src/font.c 2011-02-14 15:39:19 +0000 +++ src/font.c 2011-02-16 15:02:50 +0000 @@ -3637,7 +3637,7 @@ Lisp_Object font_object; multibyte = (NILP (string) - ? ! NILP (B_ (current_buffer, enable_multibyte_characters)) + ? ! NILP (BVAR (current_buffer, enable_multibyte_characters)) : STRING_MULTIBYTE (string)); if (c < 0) { === modified file 'src/frame.c' --- src/frame.c 2011-02-14 15:39:19 +0000 +++ src/frame.c 2011-02-16 15:02:50 +0000 @@ -1817,7 +1817,7 @@ w = XWINDOW (window); if (!NILP (w->buffer)) - B_ (XBUFFER (w->buffer), display_time) = Fcurrent_time (); + BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time (); if (!NILP (w->vchild)) make_frame_visible_1 (w->vchild); === modified file 'src/fringe.c' --- src/fringe.c 2011-02-14 15:39:19 +0000 +++ src/fringe.c 2011-02-16 15:02:50 +0000 @@ -660,7 +660,7 @@ { Lisp_Object cmap, bm = Qnil; - if ((cmap = B_ (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap)) + if ((cmap = BVAR (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap)) { bm = Fassq (cursor, cmap); if (CONSP (bm)) @@ -670,9 +670,9 @@ return lookup_fringe_bitmap (bm); } } - if (EQ (cmap, B_ (&buffer_defaults, fringe_cursor_alist))) + if (EQ (cmap, BVAR (&buffer_defaults, fringe_cursor_alist))) return NO_FRINGE_BITMAP; - bm = Fassq (cursor, B_ (&buffer_defaults, fringe_cursor_alist)); + bm = Fassq (cursor, BVAR (&buffer_defaults, fringe_cursor_alist)); if (!CONSP (bm) || ((bm = XCDR (bm)), NILP (bm))) return NO_FRINGE_BITMAP; return lookup_fringe_bitmap (bm); @@ -697,7 +697,7 @@ If partial, lookup partial bitmap in default value if not found here. If not partial, or no partial spec is present, use non-partial bitmap. */ - if ((cmap = B_ (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap)) + if ((cmap = BVAR (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap)) { bm1 = Fassq (bitmap, cmap); if (CONSP (bm1)) @@ -731,10 +731,10 @@ } } - if (!EQ (cmap, B_ (&buffer_defaults, fringe_indicator_alist)) - && !NILP (B_ (&buffer_defaults, fringe_indicator_alist))) + if (!EQ (cmap, BVAR (&buffer_defaults, fringe_indicator_alist)) + && !NILP (BVAR (&buffer_defaults, fringe_indicator_alist))) { - bm2 = Fassq (bitmap, B_ (&buffer_defaults, fringe_indicator_alist)); + bm2 = Fassq (bitmap, BVAR (&buffer_defaults, fringe_indicator_alist)); if (CONSP (bm2)) { if ((bm2 = XCDR (bm2)), !NILP (bm2)) @@ -919,7 +919,7 @@ return 0; if (!MINI_WINDOW_P (w) - && (ind = B_ (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind))) + && (ind = BVAR (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind))) { if (EQ (ind, Qleft) || EQ (ind, Qright)) boundary_top = boundary_bot = arrow_top = arrow_bot = ind; @@ -988,7 +988,7 @@ } } - empty_pos = B_ (XBUFFER (w->buffer), indicate_empty_lines); + empty_pos = BVAR (XBUFFER (w->buffer), indicate_empty_lines); if (!NILP (empty_pos) && !EQ (empty_pos, Qright)) empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft; === modified file 'src/indent.c' --- src/indent.c 2011-02-14 15:39:19 +0000 +++ src/indent.c 2011-02-16 15:02:50 +0000 @@ -70,7 +70,7 @@ { Lisp_Object thisbuf; - thisbuf = B_ (current_buffer, display_table); + thisbuf = BVAR (current_buffer, display_table); if (DISP_TABLE_P (thisbuf)) return XCHAR_TABLE (thisbuf); if (DISP_TABLE_P (Vstandard_display_table)) @@ -140,9 +140,9 @@ int i; struct Lisp_Vector *widthtab; - if (!VECTORP (B_ (buf, width_table))) - B_ (buf, width_table) = Fmake_vector (make_number (256), make_number (0)); - widthtab = XVECTOR (B_ (buf, width_table)); + if (!VECTORP (BVAR (buf, width_table))) + BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0)); + widthtab = XVECTOR (BVAR (buf, width_table)); if (widthtab->size != 256) abort (); @@ -156,17 +156,17 @@ static void width_run_cache_on_off (void) { - if (NILP (B_ (current_buffer, cache_long_line_scans)) + if (NILP (BVAR (current_buffer, cache_long_line_scans)) /* And, for the moment, this feature doesn't work on multibyte characters. */ - || !NILP (B_ (current_buffer, enable_multibyte_characters))) + || !NILP (BVAR (current_buffer, enable_multibyte_characters))) { /* It should be off. */ if (current_buffer->width_run_cache) { free_region_cache (current_buffer->width_run_cache); current_buffer->width_run_cache = 0; - B_ (current_buffer, width_table) = Qnil; + BVAR (current_buffer, width_table) = Qnil; } } else @@ -329,8 +329,8 @@ register int tab_seen; int post_tab; register int c; - register int tab_width = XINT (B_ (current_buffer, tab_width)); - int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow)); + register int tab_width = XINT (BVAR (current_buffer, tab_width)); + int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = buffer_display_table (); if (PT == last_known_column_point @@ -417,7 +417,7 @@ col++; else if (c == '\n' || (c == '\r' - && EQ (B_ (current_buffer, selective_display), Qt))) + && EQ (BVAR (current_buffer, selective_display), Qt))) { ptr++; goto start_of_line_found; @@ -512,10 +512,10 @@ static void scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) { - register EMACS_INT tab_width = XINT (B_ (current_buffer, tab_width)); - register int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow)); + register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); + register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = buffer_display_table (); - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); struct composition_it cmp_it; Lisp_Object window; struct window *w; @@ -637,7 +637,7 @@ if (c == '\n') goto endloop; - if (c == '\r' && EQ (B_ (current_buffer, selective_display), Qt)) + if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt)) goto endloop; if (c == '\t') { @@ -655,7 +655,7 @@ if (c == '\n') goto endloop; - if (c == '\r' && EQ (B_ (current_buffer, selective_display), Qt)) + if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt)) goto endloop; if (c == '\t') { @@ -809,7 +809,7 @@ { int mincol; register int fromcol; - register int tab_width = XINT (B_ (current_buffer, tab_width)); + register int tab_width = XINT (BVAR (current_buffer, tab_width)); CHECK_NUMBER (column); if (NILP (minimum)) @@ -872,7 +872,7 @@ position_indentation (register int pos_byte) { register EMACS_INT column = 0; - register EMACS_INT tab_width = XINT (B_ (current_buffer, tab_width)); + register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); register unsigned char *p; register unsigned char *stop; unsigned char *start; @@ -924,7 +924,7 @@ switch (*p++) { case 0240: - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) return column; case ' ': column++; @@ -934,7 +934,7 @@ break; default: if (ASCII_BYTE_P (p[-1]) - || NILP (B_ (current_buffer, enable_multibyte_characters))) + || NILP (BVAR (current_buffer, enable_multibyte_characters))) return column; { int c; @@ -1123,13 +1123,13 @@ register EMACS_INT pos; EMACS_INT pos_byte; register int c = 0; - register EMACS_INT tab_width = XFASTINT (B_ (current_buffer, tab_width)); - register int ctl_arrow = !NILP (B_ (current_buffer, ctl_arrow)); + register EMACS_INT tab_width = XFASTINT (BVAR (current_buffer, tab_width)); + register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = window_display_table (win); int selective - = (INTEGERP (B_ (current_buffer, selective_display)) - ? XINT (B_ (current_buffer, selective_display)) - : !NILP (B_ (current_buffer, selective_display)) ? -1 : 0); + = (INTEGERP (BVAR (current_buffer, selective_display)) + ? XINT (BVAR (current_buffer, selective_display)) + : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); int selective_rlen = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp)) ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0); @@ -1151,7 +1151,7 @@ EMACS_INT next_width_run = from; Lisp_Object window; - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); /* If previous char scanned was a wide character, this is the column where it ended. Otherwise, this is 0. */ EMACS_INT wide_column_end_hpos = 0; @@ -1170,8 +1170,8 @@ width_run_cache_on_off (); if (dp == buffer_display_table ()) - width_table = (VECTORP (B_ (current_buffer, width_table)) - ? XVECTOR (B_ (current_buffer, width_table))->contents + width_table = (VECTORP (BVAR (current_buffer, width_table)) + ? XVECTOR (BVAR (current_buffer, width_table))->contents : 0); else /* If the window has its own display table, we can't use the width @@ -1337,7 +1337,7 @@ } if (hscroll || truncate - || !NILP (B_ (current_buffer, truncate_lines))) + || !NILP (BVAR (current_buffer, truncate_lines))) { /* Truncating: skip to newline, unless we are already past TO (we need to go back below). */ @@ -1838,9 +1838,9 @@ EMACS_INT from_byte; EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0; int selective - = (INTEGERP (B_ (current_buffer, selective_display)) - ? XINT (B_ (current_buffer, selective_display)) - : !NILP (B_ (current_buffer, selective_display)) ? -1 : 0); + = (INTEGERP (BVAR (current_buffer, selective_display)) + ? XINT (BVAR (current_buffer, selective_display)) + : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); Lisp_Object window; EMACS_INT start_hpos = 0; int did_motion; === modified file 'src/insdel.c' --- src/insdel.c 2011-02-14 17:35:21 +0000 +++ src/insdel.c 2011-02-16 15:02:50 +0000 @@ -78,7 +78,7 @@ check_markers (void) { register struct Lisp_Marker *tail; - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) { @@ -703,7 +703,7 @@ unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (c, str); else { @@ -891,7 +891,7 @@ if (nchars == 0) return; - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nchars = nbytes; if (prepare) @@ -1011,7 +1011,7 @@ /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) outgoing_nbytes = nchars; else if (! STRING_MULTIBYTE (string)) outgoing_nbytes @@ -1034,7 +1034,7 @@ between single-byte and multibyte. */ copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes, STRING_MULTIBYTE (string), - ! NILP (B_ (current_buffer, enable_multibyte_characters))); + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not altered @@ -1094,7 +1094,7 @@ void insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes) { - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nchars = nbytes; record_insert (GPT, nchars); @@ -1162,9 +1162,9 @@ /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) outgoing_nbytes = nchars; - else if (NILP (B_ (buf, enable_multibyte_characters))) + else if (NILP (BVAR (buf, enable_multibyte_characters))) { EMACS_INT outgoing_before_gap = 0; EMACS_INT outgoing_after_gap = 0; @@ -1215,8 +1215,8 @@ chunk_expanded = copy_text (BUF_BYTE_ADDRESS (buf, from_byte), GPT_ADDR, chunk, - ! NILP (B_ (buf, enable_multibyte_characters)), - ! NILP (B_ (current_buffer, enable_multibyte_characters))); + ! NILP (BVAR (buf, enable_multibyte_characters)), + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); } else chunk_expanded = chunk = 0; @@ -1224,8 +1224,8 @@ if (chunk < incoming_nbytes) copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk), GPT_ADDR + chunk_expanded, incoming_nbytes - chunk, - ! NILP (B_ (buf, enable_multibyte_characters)), - ! NILP (B_ (current_buffer, enable_multibyte_characters))); + ! NILP (BVAR (buf, enable_multibyte_characters)), + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not altered @@ -1320,7 +1320,7 @@ adjust_markers_for_insert (from, from_byte, from + len, from_byte + len_byte, 0); - if (! EQ (B_ (current_buffer, undo_list), Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) { if (nchars_del > 0) record_delete (from, prev_text); @@ -1481,7 +1481,7 @@ /* Make OUTGOING_INSBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) outgoing_insbytes = inschars; else if (! STRING_MULTIBYTE (new)) outgoing_insbytes @@ -1503,7 +1503,7 @@ /* Even if we don't record for undo, we must keep the original text because we may have to recover it because of inappropriate byte combining. */ - if (! EQ (B_ (current_buffer, undo_list), Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); GAP_SIZE += nbytes_del; @@ -1530,7 +1530,7 @@ between single-byte and multibyte. */ copy_text (SDATA (new), GPT_ADDR, insbytes, STRING_MULTIBYTE (new), - ! NILP (B_ (current_buffer, enable_multibyte_characters))); + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not marked @@ -1543,7 +1543,7 @@ abort (); #endif - if (! EQ (B_ (current_buffer, undo_list), Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) { /* Record the insertion first, so that when we undo, the deletion will be undone first. Thus, undo @@ -1886,7 +1886,7 @@ abort (); #endif - if (ret_string || ! EQ (B_ (current_buffer, undo_list), Qt)) + if (ret_string || ! EQ (BVAR (current_buffer, undo_list), Qt)) deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); else deletion = Qnil; @@ -1897,7 +1897,7 @@ so that undo handles this after reinserting the text. */ adjust_markers_for_delete (from, from_byte, to, to_byte); - if (! EQ (B_ (current_buffer, undo_list), Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) record_delete (from, deletion); MODIFF++; CHARS_MODIFF = MODIFF; @@ -1968,7 +1968,7 @@ if (! preserve_chars_modiff) CHARS_MODIFF = MODIFF; - B_ (buffer, point_before_scroll) = Qnil; + BVAR (buffer, point_before_scroll) = Qnil; if (buffer != old_buffer) set_buffer_internal (old_buffer); @@ -1990,7 +1990,7 @@ { struct buffer *base_buffer; - if (!NILP (B_ (current_buffer, read_only))) + if (!NILP (BVAR (current_buffer, read_only))) Fbarf_if_buffer_read_only (); /* Let redisplay consider other windows than selected_window @@ -2022,32 +2022,32 @@ base_buffer = current_buffer; #ifdef CLASH_DETECTION - if (!NILP (B_ (base_buffer, file_truename)) + if (!NILP (BVAR (base_buffer, file_truename)) /* Make binding buffer-file-name to nil effective. */ - && !NILP (B_ (base_buffer, filename)) + && !NILP (BVAR (base_buffer, filename)) && SAVE_MODIFF >= MODIFF) - lock_file (B_ (base_buffer, file_truename)); + lock_file (BVAR (base_buffer, file_truename)); #else /* At least warn if this file has changed on disk since it was visited. */ - if (!NILP (B_ (base_buffer, filename)) + if (!NILP (BVAR (base_buffer, filename)) && SAVE_MODIFF >= MODIFF && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) - && !NILP (Ffile_exists_p (B_ (base_buffer, filename)))) + && !NILP (Ffile_exists_p (BVAR (base_buffer, filename)))) call1 (intern ("ask-user-about-supersession-threat"), - B_ (base_buffer,filename)); + BVAR (base_buffer,filename)); #endif /* not CLASH_DETECTION */ /* If `select-active-regions' is non-nil, save the region text. */ - if (!NILP (B_ (current_buffer, mark_active)) + if (!NILP (BVAR (current_buffer, mark_active)) && !inhibit_modification_hooks - && XMARKER (B_ (current_buffer, mark))->buffer + && XMARKER (BVAR (current_buffer, mark))->buffer && NILP (Vsaved_region_selection) && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) && !NILP (Vtransient_mark_mode)))) { - EMACS_INT b = XMARKER (B_ (current_buffer, mark))->charpos; + EMACS_INT b = XMARKER (BVAR (current_buffer, mark))->charpos; EMACS_INT e = PT; if (b < e) Vsaved_region_selection = make_buffer_string (b, e, 0); @@ -2290,7 +2290,7 @@ non-nil, and insertion calls a file handler (e.g. through lock_file) which scribbles into a temp file -- cyd */ if (!BUFFERP (combine_after_change_buffer) - || NILP (B_ (XBUFFER (combine_after_change_buffer), name))) + || NILP (BVAR (XBUFFER (combine_after_change_buffer), name))) { combine_after_change_list = Qnil; return Qnil; === modified file 'src/intervals.c' --- src/intervals.c 2011-02-14 15:39:19 +0000 +++ src/intervals.c 2011-02-16 15:02:50 +0000 @@ -1978,7 +1978,7 @@ int have_overlays; EMACS_INT original_position; - B_ (current_buffer, point_before_scroll) = Qnil; + BVAR (current_buffer, point_before_scroll) = Qnil; if (charpos == PT) return; @@ -2342,7 +2342,7 @@ if (EQ (type, Qkeymap)) return Qnil; else - return B_ (buffer, keymap); + return BVAR (buffer, keymap); } /* Produce an interval tree reflecting the intervals in === modified file 'src/intervals.h' --- src/intervals.h 2011-02-14 15:39:19 +0000 +++ src/intervals.h 2011-02-16 15:02:50 +0000 @@ -236,9 +236,9 @@ and 2 if it is invisible but with an ellipsis. */ #define TEXT_PROP_MEANS_INVISIBLE(prop) \ - (EQ (B_ (current_buffer, invisibility_spec), Qt) \ + (EQ (BVAR (current_buffer, invisibility_spec), Qt) \ ? !NILP (prop) \ - : invisible_p (prop, B_ (current_buffer, invisibility_spec))) + : invisible_p (prop, BVAR (current_buffer, invisibility_spec))) /* Declared in alloc.c */ === modified file 'src/keyboard.c' --- src/keyboard.c 2011-02-14 15:39:19 +0000 +++ src/keyboard.c 2011-02-16 15:02:50 +0000 @@ -1577,7 +1577,7 @@ this_single_command_key_start = 0; } - if (!NILP (B_ (current_buffer, mark_active)) + if (!NILP (BVAR (current_buffer, mark_active)) && !NILP (Vrun_hooks)) { /* In Emacs 22, setting transient-mark-mode to `only' was a @@ -1599,7 +1599,7 @@ if (!NILP (Fwindow_system (Qnil)) /* Even if mark_active is non-nil, the actual buffer marker may not have been set yet (Bug#7044). */ - && XMARKER (B_ (current_buffer, mark))->buffer + && XMARKER (BVAR (current_buffer, mark))->buffer && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) @@ -1607,7 +1607,7 @@ && !EQ (Vthis_command, Qhandle_switch_frame)) { EMACS_INT beg = - XINT (Fmarker_position (B_ (current_buffer, mark))); + XINT (Fmarker_position (BVAR (current_buffer, mark))); EMACS_INT end = PT; if (beg < end) call2 (Qx_set_selection, QPRIMARY, @@ -8608,7 +8608,7 @@ /* Prompt with that and read response. */ message2_nolog (menu, strlen (menu), - ! NILP (B_ (current_buffer, enable_multibyte_characters))); + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); /* Make believe its not a keyboard macro in case the help char is pressed. Help characters are not recorded because menu prompting @@ -9870,7 +9870,7 @@ /* Treat uppercase keys as shifted. */ || (INTEGERP (key) && (KEY_TO_CHAR (key) - < XCHAR_TABLE (B_ (current_buffer, downcase_table))->size) + < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->size) && UPPERCASEP (KEY_TO_CHAR (key)))) { Lisp_Object new_key === modified file 'src/keymap.c' --- src/keymap.c 2011-02-14 15:39:19 +0000 +++ src/keymap.c 2011-02-16 15:02:50 +0000 @@ -1883,7 +1883,7 @@ (Lisp_Object keys, Lisp_Object accept_default) { register Lisp_Object map; - map = B_ (current_buffer, keymap); + map = BVAR (current_buffer, keymap); if (NILP (map)) return Qnil; return Flookup_key (map, keys, accept_default); @@ -1988,7 +1988,7 @@ if (!NILP (keymap)) keymap = get_keymap (keymap, 1, 1); - B_ (current_buffer, keymap) = keymap; + BVAR (current_buffer, keymap) = keymap; return Qnil; } @@ -1998,7 +1998,7 @@ Normally the local keymap is set by the major mode with `use-local-map'. */) (void) { - return B_ (current_buffer, keymap); + return BVAR (current_buffer, keymap); } DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, @@ -2379,7 +2379,7 @@ *p++ = 'C'; } else if (c < 128 - || (NILP (B_ (current_buffer, enable_multibyte_characters)) + || (NILP (BVAR (current_buffer, enable_multibyte_characters)) && SINGLE_BYTE_CHAR_P (c) && !force_multibyte)) { @@ -2388,7 +2388,7 @@ else { /* Now we are sure that C is a valid character code. */ - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! force_multibyte) *p++ = multibyte_char_to_unibyte (c, Qnil); else @@ -3048,7 +3048,7 @@ XBUFFER (buffer), Qlocal_map); if (!NILP (start1)) { - if (EQ (start1, B_ (XBUFFER (buffer), keymap))) + if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) describe_map_tree (start1, 1, shadow, prefix, "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); else === modified file 'src/lisp.h' --- src/lisp.h 2011-02-16 00:33:44 +0000 +++ src/lisp.h 2011-02-16 15:02:50 +0000 @@ -2047,11 +2047,11 @@ /* Current buffer's map from characters to lower-case characters. */ -#define DOWNCASE_TABLE B_ (current_buffer, downcase_table) +#define DOWNCASE_TABLE BVAR (current_buffer, downcase_table) /* Current buffer's map from characters to upper-case characters. */ -#define UPCASE_TABLE B_ (current_buffer, upcase_table) +#define UPCASE_TABLE BVAR (current_buffer, upcase_table) /* Downcase a character, or make no change if that cannot be done. */ === modified file 'src/lread.c' --- src/lread.c 2011-02-14 15:39:19 +0000 +++ src/lread.c 2011-02-16 15:02:50 +0000 @@ -210,7 +210,7 @@ if (pt_byte >= BUF_ZV_BYTE (inbuffer)) return -1; - if (! NILP (B_ (inbuffer, enable_multibyte_characters))) + if (! NILP (BVAR (inbuffer, enable_multibyte_characters))) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); @@ -239,7 +239,7 @@ if (bytepos >= BUF_ZV_BYTE (inbuffer)) return -1; - if (! NILP (B_ (inbuffer, enable_multibyte_characters))) + if (! NILP (BVAR (inbuffer, enable_multibyte_characters))) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); @@ -371,7 +371,7 @@ EMACS_INT bytepos = BUF_PT_BYTE (b); BUF_PT (b)--; - if (! NILP (B_ (b, enable_multibyte_characters))) + if (! NILP (BVAR (b, enable_multibyte_characters))) BUF_DEC_POS (b, bytepos); else bytepos--; @@ -384,7 +384,7 @@ EMACS_INT bytepos = XMARKER (readcharfun)->bytepos; XMARKER (readcharfun)->charpos--; - if (! NILP (B_ (b, enable_multibyte_characters))) + if (! NILP (BVAR (b, enable_multibyte_characters))) BUF_DEC_POS (b, bytepos); else bytepos--; @@ -1322,7 +1322,7 @@ /* Of course, this could conceivably lose if luser sets default-directory to be something non-absolute... */ { - filename = Fexpand_file_name (filename, B_ (current_buffer, directory)); + filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); if (!complete_filename_p (filename)) /* Give up on this path element! */ continue; @@ -1581,7 +1581,7 @@ { int count1 = SPECPDL_INDEX (); - if (b != 0 && NILP (B_ (b, name))) + if (b != 0 && NILP (BVAR (b, name))) error ("Reading from killed buffer"); if (!NILP (start)) @@ -1721,7 +1721,7 @@ tem = printflag; if (NILP (filename)) - filename = B_ (XBUFFER (buf), filename); + filename = BVAR (XBUFFER (buf), filename); specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); @@ -1761,7 +1761,7 @@ specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); /* readevalloop calls functions which check the type of start and end. */ - readevalloop (cbuf, 0, B_ (XBUFFER (cbuf), filename), Feval, + readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename), Feval, !NILP (printflag), Qnil, read_function, start, end); === modified file 'src/marker.c' --- src/marker.c 2011-02-14 15:39:19 +0000 +++ src/marker.c 2011-02-16 15:02:50 +0000 @@ -439,7 +439,7 @@ does not preserve the buffer from being GC'd (it's weak), so markers have to be unlinked from their buffer as soon as the buffer is killed. */ - eassert (!NILP (B_ (XBUFFER (buf), name))); + eassert (!NILP (BVAR (XBUFFER (buf), name))); return buf; } return Qnil; @@ -488,7 +488,7 @@ CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (B_ (b, name), Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -563,7 +563,7 @@ CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (B_ (b, name), Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -628,7 +628,7 @@ CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (B_ (b, name), Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -676,7 +676,7 @@ CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (B_ (b, name), Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -731,7 +731,7 @@ if (b == 0) return; - if (EQ (B_ (b, name), Qnil)) + if (EQ (BVAR (b, name), Qnil)) abort (); marker->buffer = 0; === modified file 'src/minibuf.c' --- src/minibuf.c 2011-02-14 15:39:19 +0000 +++ src/minibuf.c 2011-02-16 15:02:50 +0000 @@ -415,7 +415,7 @@ CHECK_STRING (initial); } val = Qnil; - ambient_dir = B_ (current_buffer, directory); + ambient_dir = BVAR (current_buffer, directory); input_method = Qnil; enable_multibyte = Qnil; @@ -525,7 +525,7 @@ /* `current-input-method' is buffer local. So, remember it in INPUT_METHOD before changing the current buffer. */ input_method = Fsymbol_value (Qcurrent_input_method); - enable_multibyte = B_ (current_buffer, enable_multibyte_characters); + enable_multibyte = BVAR (current_buffer, enable_multibyte_characters); } /* Switch to the minibuffer. */ @@ -535,7 +535,7 @@ /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ if (inherit_input_method) - B_ (current_buffer, enable_multibyte_characters) = enable_multibyte; + BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte; /* The current buffer's default directory is usually the right thing for our minibuffer here. However, if you're typing a command at @@ -546,7 +546,7 @@ you think of something better to do? Find another buffer with a better directory, and use that one instead. */ if (STRINGP (ambient_dir)) - B_ (current_buffer, directory) = ambient_dir; + BVAR (current_buffer, directory) = ambient_dir; else { Lisp_Object buf_list; @@ -558,9 +558,9 @@ Lisp_Object other_buf; other_buf = XCDR (XCAR (buf_list)); - if (STRINGP (B_ (XBUFFER (other_buf), directory))) + if (STRINGP (BVAR (XBUFFER (other_buf), directory))) { - B_ (current_buffer, directory) = B_ (XBUFFER (other_buf), directory); + BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory); break; } } @@ -603,7 +603,7 @@ specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); - if (!NILP (B_ (current_buffer, enable_multibyte_characters)) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! STRING_MULTIBYTE (minibuf_prompt)) minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); @@ -633,7 +633,7 @@ } clear_message (1, 1); - B_ (current_buffer, keymap) = map; + BVAR (current_buffer, keymap) = map; /* Turn on an input method stored in INPUT_METHOD if any. */ if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) @@ -647,7 +647,7 @@ call1 (Vrun_hooks, Qminibuffer_setup_hook); /* Don't allow the user to undo past this point. */ - B_ (current_buffer, undo_list) = Qnil; + BVAR (current_buffer, undo_list) = Qnil; recursive_edit_1 (); @@ -764,7 +764,7 @@ Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } buf = Fcar (tail); - if (NILP (buf) || NILP (B_ (XBUFFER (buf), name))) + if (NILP (buf) || NILP (BVAR (XBUFFER (buf), name))) { sprintf (name, " *Minibuf-%d*", depth); buf = Fget_buffer_create (build_string (name)); @@ -1096,7 +1096,7 @@ int count = SPECPDL_INDEX (); if (BUFFERP (def)) - def = B_ (XBUFFER (def), name); + def = BVAR (XBUFFER (def), name); specbind (Qcompletion_ignore_case, read_buffer_completion_ignore_case ? Qt : Qnil); === modified file 'src/msdos.c' --- src/msdos.c 2011-02-14 17:58:13 +0000 +++ src/msdos.c 2011-02-16 15:02:50 +0000 @@ -1317,12 +1317,12 @@ { struct buffer *b = XBUFFER (sw->buffer); - if (EQ (B_ (b,cursor_type), Qt)) + if (EQ (BVAR (b,cursor_type), Qt)) new_cursor = frame_desired_cursor; - else if (NILP (B_ (b, cursor_type))) /* nil means no cursor */ + else if (NILP (BVAR (b, cursor_type))) /* nil means no cursor */ new_cursor = Fcons (Qbar, make_number (0)); else - new_cursor = B_ (b, cursor_type); + new_cursor = BVAR (b, cursor_type); } IT_set_cursor_type (f, new_cursor); === modified file 'src/print.c' --- src/print.c 2011-02-14 22:25:29 +0000 +++ src/print.c 2011-02-16 15:02:50 +0000 @@ -111,7 +111,7 @@ EMACS_INT old_point_byte = -1, start_point_byte = -1; \ int specpdl_count = SPECPDL_INDEX (); \ int free_print_buffer = 0; \ - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); \ + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ Lisp_Object original #define PRINTPREPARE \ @@ -144,10 +144,10 @@ if (NILP (printcharfun)) \ { \ Lisp_Object string; \ - if (NILP (B_ (current_buffer, enable_multibyte_characters)) \ + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \ && ! print_escape_multibyte) \ specbind (Qprint_escape_multibyte, Qt); \ - if (! NILP (B_ (current_buffer, enable_multibyte_characters)) \ + if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \ && ! print_escape_nonascii) \ specbind (Qprint_escape_nonascii, Qt); \ if (print_buffer != 0) \ @@ -173,7 +173,7 @@ if (NILP (printcharfun)) \ { \ if (print_buffer_pos != print_buffer_pos_byte \ - && NILP (B_ (current_buffer, enable_multibyte_characters))) \ + && NILP (BVAR (current_buffer, enable_multibyte_characters))) \ { \ unsigned char *temp \ = (unsigned char *) alloca (print_buffer_pos + 1); \ @@ -250,7 +250,7 @@ else { int multibyte_p - = !NILP (B_ (current_buffer, enable_multibyte_characters)); + = !NILP (BVAR (current_buffer, enable_multibyte_characters)); setup_echo_area_for_printing (multibyte_p); insert_char (ch); @@ -302,7 +302,7 @@ job. */ int i; int multibyte_p - = !NILP (B_ (current_buffer, enable_multibyte_characters)); + = !NILP (BVAR (current_buffer, enable_multibyte_characters)); setup_echo_area_for_printing (multibyte_p); message_dolog (ptr, size_byte, 0, multibyte_p); @@ -371,8 +371,8 @@ chars = SCHARS (string); else if (! print_escape_nonascii && (EQ (printcharfun, Qt) - ? ! NILP (B_ (&buffer_defaults, enable_multibyte_characters)) - : ! NILP (B_ (current_buffer, enable_multibyte_characters)))) + ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)) + : ! NILP (BVAR (current_buffer, enable_multibyte_characters)))) { /* If unibyte string STRING contains 8-bit codes, we must convert STRING to a multibyte string containing the same @@ -504,14 +504,14 @@ Fkill_all_local_variables (); delete_all_overlays (current_buffer); - B_ (current_buffer, directory) = B_ (old, directory); - B_ (current_buffer, read_only) = Qnil; - B_ (current_buffer, filename) = Qnil; - B_ (current_buffer, undo_list) = Qt; + BVAR (current_buffer, directory) = BVAR (old, directory); + BVAR (current_buffer, read_only) = Qnil; + BVAR (current_buffer, filename) = Qnil; + BVAR (current_buffer, undo_list) = Qt; eassert (current_buffer->overlays_before == NULL); eassert (current_buffer->overlays_after == NULL); - B_ (current_buffer, enable_multibyte_characters) - = B_ (&buffer_defaults, enable_multibyte_characters); + BVAR (current_buffer, enable_multibyte_characters) + = BVAR (&buffer_defaults, enable_multibyte_characters); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -1856,7 +1856,7 @@ if (!NILP (XWINDOW (obj)->buffer)) { strout (" on ", -1, -1, printcharfun, 0); - print_string (B_ (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); + print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); } PRINTCHAR ('>'); } @@ -1957,16 +1957,16 @@ } else if (BUFFERP (obj)) { - if (NILP (B_ (XBUFFER (obj), name))) + if (NILP (BVAR (XBUFFER (obj), name))) strout ("#", -1, -1, printcharfun, 0); else if (escapeflag) { strout ("#'); } else - print_string (B_ (XBUFFER (obj), name), printcharfun); + print_string (BVAR (XBUFFER (obj), name), printcharfun); } else if (WINDOW_CONFIGURATIONP (obj)) { @@ -2078,7 +2078,7 @@ sprintf (buf, "at %ld", (long)marker_position (obj)); strout (buf, -1, -1, printcharfun, 0); strout (" in ", -1, -1, printcharfun, 0); - print_string (B_ (XMARKER (obj)->buffer, name), printcharfun); + print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); } PRINTCHAR ('>'); break; @@ -2093,7 +2093,7 @@ (long)marker_position (OVERLAY_START (obj)), (long)marker_position (OVERLAY_END (obj))); strout (buf, -1, -1, printcharfun, 0); - print_string (B_ (XMARKER (OVERLAY_START (obj))->buffer, name), + print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), printcharfun); } PRINTCHAR ('>'); === modified file 'src/process.c' --- src/process.c 2011-02-14 15:39:19 +0000 +++ src/process.c 2011-02-16 15:02:50 +0000 @@ -719,7 +719,7 @@ { proc = Fget_buffer_process (obj); if (NILP (proc)) - error ("Buffer %s has no process", SDATA (B_ (XBUFFER (obj), name))); + error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name))); } else { @@ -1283,12 +1283,12 @@ w_proc = i; if (!NILP (p->buffer)) { - if (NILP (B_ (XBUFFER (p->buffer), name))) + if (NILP (BVAR (XBUFFER (p->buffer), name))) { if (w_buffer < 8) w_buffer = 8; /* (Killed) */ } - else if ((i = SCHARS (B_ (XBUFFER (p->buffer), name)), (i > w_buffer))) + else if ((i = SCHARS (BVAR (XBUFFER (p->buffer), name)), (i > w_buffer))) w_buffer = i; } if (STRINGP (p->tty_name) @@ -1312,9 +1312,9 @@ XSETFASTINT (minspace, 1); set_buffer_internal (XBUFFER (Vstandard_output)); - B_ (current_buffer, undo_list) = Qt; + BVAR (current_buffer, undo_list) = Qt; - B_ (current_buffer, truncate_lines) = Qt; + BVAR (current_buffer, truncate_lines) = Qt; write_string ("Proc", -1); Findent_to (i_status, minspace); write_string ("Status", -1); @@ -1397,10 +1397,10 @@ Findent_to (i_buffer, minspace); if (NILP (p->buffer)) insert_string ("(none)"); - else if (NILP (B_ (XBUFFER (p->buffer), name))) + else if (NILP (BVAR (XBUFFER (p->buffer), name))) insert_string ("(Killed)"); else - Finsert (1, &B_ (XBUFFER (p->buffer), name)); + Finsert (1, &BVAR (XBUFFER (p->buffer), name)); if (!NILP (i_tty)) { @@ -1548,7 +1548,7 @@ { struct gcpro gcpro1, gcpro2; - current_dir = B_ (current_buffer, directory); + current_dir = BVAR (current_buffer, directory); GCPRO2 (buffer, current_dir); @@ -1560,7 +1560,7 @@ current_dir = expand_and_dir_to_file (current_dir, Qnil); if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (B_ (current_buffer, directory), Qnil)); + Fcons (BVAR (current_buffer, directory), Qnil)); UNGCPRO; } @@ -2898,8 +2898,8 @@ } else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; - else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) - || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; p->decode_coding_system = val; @@ -2912,8 +2912,8 @@ } else if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) - || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; p->encode_coding_system = val; @@ -3723,8 +3723,8 @@ } else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; - else if ((!NILP (buffer) && NILP (B_ (XBUFFER (buffer), enable_multibyte_characters))) - || (NILP (buffer) && NILP (B_ (&buffer_defaults, enable_multibyte_characters)))) + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) /* We dare not decode end-of-line format by setting VAL to Qraw_text, because the existing Emacs Lisp libraries assume that they receive bare code including a sequene of @@ -3759,7 +3759,7 @@ } else if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if (NILP (B_ (current_buffer, enable_multibyte_characters))) + else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) val = Qnil; else { @@ -5268,7 +5268,7 @@ /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ XSETBUFFER (obuffer, current_buffer); - okeymap = B_ (current_buffer, keymap); + okeymap = BVAR (current_buffer, keymap); /* We inhibit quit here instead of just catching it so that hitting ^G when a filter happens to be running won't screw @@ -5359,7 +5359,7 @@ } /* If no filter, write into buffer if it isn't dead. */ - else if (!NILP (p->buffer) && !NILP (B_ (XBUFFER (p->buffer), name))) + else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name))) { Lisp_Object old_read_only; EMACS_INT old_begv, old_zv; @@ -5372,13 +5372,13 @@ Fset_buffer (p->buffer); opoint = PT; opoint_byte = PT_BYTE; - old_read_only = B_ (current_buffer, read_only); + old_read_only = BVAR (current_buffer, read_only); old_begv = BEGV; old_zv = ZV; old_begv_byte = BEGV_BYTE; old_zv_byte = ZV_BYTE; - B_ (current_buffer, read_only) = Qnil; + BVAR (current_buffer, read_only) = Qnil; /* Insert new output into buffer at the current end-of-output marker, @@ -5423,7 +5423,7 @@ p->decoding_carryover = coding->carryover_bytes; } /* Adjust the multibyteness of TEXT to that of the buffer. */ - if (NILP (B_ (current_buffer, enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) != ! STRING_MULTIBYTE (text)) text = (STRING_MULTIBYTE (text) ? Fstring_as_unibyte (text) @@ -5467,7 +5467,7 @@ Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); - B_ (current_buffer, read_only) = old_read_only; + BVAR (current_buffer, read_only) = old_read_only; SET_PT_BOTH (opoint, opoint_byte); } /* Handling the process output should not deactivate the mark. */ @@ -5525,7 +5525,7 @@ if ((STRINGP (object) && STRING_MULTIBYTE (object)) || (BUFFERP (object) - && !NILP (B_ (XBUFFER (object), enable_multibyte_characters))) + && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters))) || EQ (object, Qt)) { p->encode_coding_system @@ -6564,7 +6564,7 @@ is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; XSETBUFFER (obuffer, current_buffer); - okeymap = B_ (current_buffer, keymap); + okeymap = BVAR (current_buffer, keymap); /* There's no good reason to let sentinels change the current buffer, and many callers of accept-process-output, sit-for, and @@ -6714,7 +6714,7 @@ /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ - if (NILP (B_ (XBUFFER (buffer), name))) + if (NILP (BVAR (XBUFFER (buffer), name))) continue; Fset_buffer (buffer); @@ -6731,13 +6731,13 @@ before = PT; before_byte = PT_BYTE; - tem = B_ (current_buffer, read_only); - B_ (current_buffer, read_only) = Qnil; + tem = BVAR (current_buffer, read_only); + BVAR (current_buffer, read_only) = Qnil; insert_string ("\nProcess "); Finsert (1, &p->name); insert_string (" "); Finsert (1, &msg); - B_ (current_buffer, read_only) = tem; + BVAR (current_buffer, read_only) = tem; set_marker_both (p->mark, p->buffer, PT, PT_BYTE); if (opoint >= before) @@ -7136,7 +7136,7 @@ ; else if (BUFFERP (p->buffer)) { - if (NILP (B_ (XBUFFER (p->buffer), enable_multibyte_characters))) + if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters))) coding_system = raw_text_coding_system (coding_system); } setup_coding_system (coding_system, proc_decode_coding_system[inch]); === modified file 'src/search.c' --- src/search.c 2011-02-14 15:39:19 +0000 +++ src/search.c 2011-02-16 15:02:50 +0000 @@ -157,7 +157,7 @@ /* If the compiled pattern hard codes some of the contents of the syntax-table, it can only be reused with *this* syntax table. */ - cp->syntax_table = cp->buf.used_syntax ? B_ (current_buffer, syntax_table) : Qt; + cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt; re_set_whitespace_regexp (NULL); @@ -236,7 +236,7 @@ && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) && cp->posix == posix && (EQ (cp->syntax_table, Qt) - || EQ (cp->syntax_table, B_ (current_buffer, syntax_table))) + || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table))) && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)) && cp->buf.charset_unibyte == charset_unibyte) break; @@ -285,17 +285,17 @@ save_search_regs (); /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] - = B_ (current_buffer, case_eqv_table); + XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] + = BVAR (current_buffer, case_eqv_table); CHECK_STRING (string); bufp = compile_pattern (string, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), - (!NILP (B_ (current_buffer, case_fold_search)) - ? B_ (current_buffer, case_canon_table) : Qnil), + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), posix, - !NILP (B_ (current_buffer, enable_multibyte_characters))); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); immediate_quit = 1; QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ @@ -400,14 +400,14 @@ } /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] - = B_ (current_buffer, case_eqv_table); + XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] + = BVAR (current_buffer, case_eqv_table); bufp = compile_pattern (regexp, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), - (!NILP (B_ (current_buffer, case_fold_search)) - ? B_ (current_buffer, case_canon_table) : Qnil), + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), posix, STRING_MULTIBYTE (string)); immediate_quit = 1; @@ -586,7 +586,7 @@ s2 = 0; } re_match_object = Qnil; - multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); } buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); @@ -608,7 +608,7 @@ static void newline_cache_on_off (struct buffer *buf) { - if (NILP (B_ (buf, cache_long_line_scans))) + if (NILP (BVAR (buf, cache_long_line_scans))) { /* It should be off. */ if (buf->newline_cache) @@ -996,15 +996,15 @@ } /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (B_ (current_buffer, case_canon_table))->extras[2] - = B_ (current_buffer, case_eqv_table); + XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] + = BVAR (current_buffer, case_eqv_table); np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE, - (!NILP (B_ (current_buffer, case_fold_search)) - ? B_ (current_buffer, case_canon_table) + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), - (!NILP (B_ (current_buffer, case_fold_search)) - ? B_ (current_buffer, case_eqv_table) + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_eqv_table) : Qnil), posix); if (np <= 0) @@ -1133,7 +1133,7 @@ (NILP (Vinhibit_changing_match_data) ? &search_regs : &search_regs_1), trt, posix, - !NILP (B_ (current_buffer, enable_multibyte_characters))); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); immediate_quit = 1; /* Quit immediately if user types ^G, because letting this function finish @@ -1254,7 +1254,7 @@ EMACS_INT raw_pattern_size; EMACS_INT raw_pattern_size_byte; unsigned char *patbuf; - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); unsigned char *base_pat; /* Set to positive if we find a non-ASCII char that need translation. Otherwise set to zero later. */ @@ -1451,7 +1451,7 @@ EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT lim, EMACS_INT lim_byte) { - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); int forward = n > 0; /* Number of buffer bytes matched. Note that this may be different from len_byte in a multibyte buffer. */ @@ -1671,7 +1671,7 @@ register EMACS_INT i; register int j; unsigned char *pat, *pat_end; - int multibyte = ! NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); unsigned char simple_translate[0400]; /* These are set to the preceding bytes of a byte to be translated @@ -2639,7 +2639,7 @@ EMACS_INT length = SBYTES (newtext); unsigned char *substed; EMACS_INT substed_alloc_size, substed_len; - int buf_multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); int str_multibyte = STRING_MULTIBYTE (newtext); Lisp_Object rev_tbl; int really_changed = 0; === modified file 'src/syntax.c' --- src/syntax.c 2011-02-14 15:39:19 +0000 +++ src/syntax.c 2011-02-16 15:02:50 +0000 @@ -277,7 +277,7 @@ else { gl_state.use_global = 0; - gl_state.current_syntax_table = B_ (current_buffer, syntax_table); + gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); } } @@ -363,7 +363,7 @@ static INLINE EMACS_INT dec_bytepos (EMACS_INT bytepos) { - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return bytepos - 1; DEC_POS (bytepos); @@ -779,7 +779,7 @@ This is the one specified by the current buffer. */) (void) { - return B_ (current_buffer, syntax_table); + return BVAR (current_buffer, syntax_table); } DEFUN ("standard-syntax-table", Fstandard_syntax_table, @@ -824,7 +824,7 @@ { int idx; check_syntax_table (table); - B_ (current_buffer, syntax_table) = table; + BVAR (current_buffer, syntax_table) = table; /* Indicate that this buffer now has a specified syntax table. */ idx = PER_BUFFER_VAR_IDX (syntax_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); @@ -1035,7 +1035,7 @@ CHECK_CHARACTER (c); if (NILP (syntax_table)) - syntax_table = B_ (current_buffer, syntax_table); + syntax_table = BVAR (current_buffer, syntax_table); else check_syntax_table (syntax_table); @@ -1450,7 +1450,7 @@ if (XINT (lim) < BEGV) XSETFASTINT (lim, BEGV); - multibyte = (!NILP (B_ (current_buffer, enable_multibyte_characters)) + multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); string_multibyte = SBYTES (string) > SCHARS (string); @@ -1936,7 +1936,7 @@ if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) return make_number (0); - multibyte = (!NILP (B_ (current_buffer, enable_multibyte_characters)) + multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); memset (fastmap, 0, sizeof fastmap); @@ -2703,7 +2703,7 @@ while (from > stop) { temp_pos = from_byte; - if (! NILP (B_ (current_buffer, enable_multibyte_characters))) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) DEC_POS (temp_pos); else temp_pos--; === modified file 'src/syntax.h' --- src/syntax.h 2011-02-14 15:39:19 +0000 +++ src/syntax.h 2011-02-16 15:02:50 +0000 @@ -24,7 +24,7 @@ /* The standard syntax table is stored where it will automatically be used in all new buffers. */ -#define Vstandard_syntax_table B_ (&buffer_defaults, syntax_table) +#define Vstandard_syntax_table BVAR (&buffer_defaults, syntax_table) /* A syntax table is a chartable whose elements are cons cells (CODE+FLAGS . MATCHING-CHAR). MATCHING-CHAR can be nil if the char @@ -79,7 +79,7 @@ # define CURRENT_SYNTAX_TABLE gl_state.current_syntax_table #else # define SYNTAX_ENTRY SYNTAX_ENTRY_INT -# define CURRENT_SYNTAX_TABLE B_ (current_buffer, syntax_table) +# define CURRENT_SYNTAX_TABLE BVAR (current_buffer, syntax_table) #endif #define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) @@ -204,7 +204,7 @@ do \ { \ gl_state.use_global = 0; \ - gl_state.current_syntax_table = B_ (current_buffer, syntax_table); \ + gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); \ } while (0) /* This macro should be called with FROM at the start of forward === modified file 'src/undo.c' --- src/undo.c 2011-02-14 15:39:19 +0000 +++ src/undo.c 2011-02-16 15:02:50 +0000 @@ -73,12 +73,12 @@ Fundo_boundary (); last_undo_buffer = current_buffer; - if (CONSP (B_ (current_buffer, undo_list))) + if (CONSP (BVAR (current_buffer, undo_list))) { /* Set AT_BOUNDARY to 1 only when we have nothing other than marker adjustment before undo boundary. */ - Lisp_Object tail = B_ (current_buffer, undo_list), elt; + Lisp_Object tail = BVAR (current_buffer, undo_list), elt; while (1) { @@ -103,8 +103,8 @@ if (at_boundary && current_buffer == last_boundary_buffer && last_boundary_position != pt) - B_ (current_buffer, undo_list) - = Fcons (make_number (last_boundary_position), B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) + = Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list)); } /* Record an insertion that just happened or is about to happen, @@ -117,17 +117,17 @@ { Lisp_Object lbeg, lend; - if (EQ (B_ (current_buffer, undo_list), Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; record_point (beg); /* If this is following another insertion and consecutive with it in the buffer, combine the two. */ - if (CONSP (B_ (current_buffer, undo_list))) + if (CONSP (BVAR (current_buffer, undo_list))) { Lisp_Object elt; - elt = XCAR (B_ (current_buffer, undo_list)); + elt = XCAR (BVAR (current_buffer, undo_list)); if (CONSP (elt) && INTEGERP (XCAR (elt)) && INTEGERP (XCDR (elt)) @@ -140,8 +140,8 @@ XSETFASTINT (lbeg, beg); XSETINT (lend, beg + length); - B_ (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), - B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), + BVAR (current_buffer, undo_list)); } /* Record that a deletion is about to take place, @@ -152,7 +152,7 @@ { Lisp_Object sbeg; - if (EQ (B_ (current_buffer, undo_list), Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; if (PT == beg + SCHARS (string)) @@ -166,8 +166,8 @@ record_point (beg); } - B_ (current_buffer, undo_list) - = Fcons (Fcons (string, sbeg), B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) + = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)); } /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT. @@ -178,7 +178,7 @@ void record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) { - if (EQ (B_ (current_buffer, undo_list), Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ @@ -189,9 +189,9 @@ Fundo_boundary (); last_undo_buffer = current_buffer; - B_ (current_buffer, undo_list) + BVAR (current_buffer, undo_list) = Fcons (Fcons (marker, make_number (adjustment)), - B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list)); } /* Record that a replacement is about to take place, @@ -215,7 +215,7 @@ Lisp_Object high, low; struct buffer *base_buffer = current_buffer; - if (EQ (B_ (current_buffer, undo_list), Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; if (current_buffer != last_undo_buffer) @@ -227,7 +227,7 @@ XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); XSETFASTINT (low, base_buffer->modtime & 0xffff); - B_ (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), BVAR (current_buffer, undo_list)); } /* Record a change in property PROP (whose old value was VAL) @@ -242,7 +242,7 @@ struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); int boundary = 0; - if (EQ (B_ (buf, undo_list), Qt)) + if (EQ (BVAR (buf, undo_list), Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ @@ -265,7 +265,7 @@ XSETINT (lbeg, beg); XSETINT (lend, beg + length); entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); - B_ (current_buffer, undo_list) = Fcons (entry, B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = Fcons (entry, BVAR (current_buffer, undo_list)); current_buffer = obuf; } @@ -277,9 +277,9 @@ (void) { Lisp_Object tem; - if (EQ (B_ (current_buffer, undo_list), Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return Qnil; - tem = Fcar (B_ (current_buffer, undo_list)); + tem = Fcar (BVAR (current_buffer, undo_list)); if (!NILP (tem)) { /* One way or another, cons nil onto the front of the undo list. */ @@ -287,12 +287,12 @@ { /* If we have preallocated the cons cell to use here, use that one. */ - XSETCDR (pending_boundary, B_ (current_buffer, undo_list)); - B_ (current_buffer, undo_list) = pending_boundary; + XSETCDR (pending_boundary, BVAR (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = pending_boundary; pending_boundary = Qnil; } else - B_ (current_buffer, undo_list) = Fcons (Qnil, B_ (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list)); } last_boundary_position = PT; last_boundary_buffer = current_buffer; @@ -321,7 +321,7 @@ record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); set_buffer_internal (b); - list = B_ (b, undo_list); + list = BVAR (b, undo_list); prev = Qnil; next = list; @@ -433,7 +433,7 @@ XSETCDR (last_boundary, Qnil); /* There's nothing we decided to keep, so clear it out. */ else - B_ (b, undo_list) = Qnil; + BVAR (b, undo_list) = Qnil; unbind_to (count, Qnil); } @@ -470,13 +470,13 @@ /* In a writable buffer, enable undoing read-only text that is so because of text properties. */ - if (NILP (B_ (current_buffer, read_only))) + if (NILP (BVAR (current_buffer, read_only))) specbind (Qinhibit_read_only, Qt); /* Don't let `intangible' properties interfere with undo. */ specbind (Qinhibit_point_motion_hooks, Qt); - oldlist = B_ (current_buffer, undo_list); + oldlist = BVAR (current_buffer, undo_list); while (arg > 0) { @@ -631,9 +631,9 @@ so the test in `undo' for continuing an undo series will work right. */ if (did_apply - && EQ (oldlist, B_ (current_buffer, undo_list))) - B_ (current_buffer, undo_list) - = Fcons (list3 (Qapply, Qcdr, Qnil), B_ (current_buffer, undo_list)); + && EQ (oldlist, BVAR (current_buffer, undo_list))) + BVAR (current_buffer, undo_list) + = Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)); UNGCPRO; return unbind_to (count, list); === modified file 'src/w32fns.c' --- src/w32fns.c 2011-02-14 17:35:21 +0000 +++ src/w32fns.c 2011-02-16 15:02:50 +0000 @@ -5225,7 +5225,7 @@ Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - B_ (current_buffer, truncate_lines) = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5655,7 +5655,7 @@ /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); - B_ (current_buffer, truncate_lines) = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); @@ -6162,7 +6162,7 @@ CHECK_STRING (document); /* Encode filename, current directory and parameters. */ - current_dir = ENCODE_FILE (B_ (current_buffer, directory)); + current_dir = ENCODE_FILE (BVAR (current_buffer, directory)); document = ENCODE_FILE (document); if (STRINGP (parameters)) parameters = ENCODE_SYSTEM (parameters); === modified file 'src/window.c' --- src/window.c 2011-02-14 15:39:19 +0000 +++ src/window.c 2011-02-16 15:02:50 +0000 @@ -1359,8 +1359,8 @@ { struct buffer *b = XBUFFER (w->buffer); - if (DISP_TABLE_P (B_ (b, display_table))) - dp = XCHAR_TABLE (B_ (b, display_table)); + if (DISP_TABLE_P (BVAR (b, display_table))) + dp = XCHAR_TABLE (BVAR (b, display_table)); else if (DISP_TABLE_P (Vstandard_display_table)) dp = XCHAR_TABLE (Vstandard_display_table); } @@ -1414,9 +1414,9 @@ So don't clobber point in that buffer. */ if (! EQ (buf, XWINDOW (selected_window)->buffer) /* This line helps to fix Horsley's testbug.el bug. */ - && !(WINDOWP (B_ (b, last_selected_window)) - && w != XWINDOW (B_ (b, last_selected_window)) - && EQ (buf, XWINDOW (B_ (b, last_selected_window))->buffer))) + && !(WINDOWP (BVAR (b, last_selected_window)) + && w != XWINDOW (BVAR (b, last_selected_window)) + && EQ (buf, XWINDOW (BVAR (b, last_selected_window))->buffer))) temp_set_point_both (b, clip_to_bounds (BUF_BEGV (b), XMARKER (w->pointm)->charpos, @@ -1425,9 +1425,9 @@ marker_byte_position (w->pointm), BUF_ZV_BYTE (b))); - if (WINDOWP (B_ (b, last_selected_window)) - && w == XWINDOW (B_ (b, last_selected_window))) - B_ (b, last_selected_window) = Qnil; + if (WINDOWP (BVAR (b, last_selected_window)) + && w == XWINDOW (BVAR (b, last_selected_window))) + BVAR (b, last_selected_window) = Qnil; } /* Put replacement into the window structure in place of old. */ @@ -2325,7 +2325,7 @@ /* Check for a window that has a killed buffer. */ case CHECK_ALL_WINDOWS: if (! NILP (w->buffer) - && NILP (B_ (XBUFFER (w->buffer), name))) + && NILP (BVAR (XBUFFER (w->buffer), name))) abort (); break; @@ -2729,7 +2729,7 @@ { int safe_size = (MIN_SAFE_WINDOW_HEIGHT + ((BUFFERP (w->buffer) - && !NILP (B_ (XBUFFER (w->buffer), mode_line_format))) + && !NILP (BVAR (XBUFFER (w->buffer), mode_line_format))) ? 1 : 0)); return safe_p ? safe_size : max (window_min_height, safe_size); @@ -3360,15 +3360,15 @@ w->buffer = buffer; if (EQ (window, selected_window)) - B_ (b, last_selected_window) = window; + BVAR (b, last_selected_window) = window; /* Let redisplay errors through. */ b->display_error_modiff = 0; /* Update time stamps of buffer display. */ - if (INTEGERP (B_ (b, display_count))) - XSETINT (B_ (b, display_count), XINT (B_ (b, display_count)) + 1); - B_ (b, display_time) = Fcurrent_time (); + if (INTEGERP (BVAR (b, display_count))) + XSETINT (BVAR (b, display_count), XINT (BVAR (b, display_count)) + 1); + BVAR (b, display_time) = Fcurrent_time (); XSETFASTINT (w->window_end_pos, 0); XSETFASTINT (w->window_end_vpos, 0); @@ -3421,18 +3421,18 @@ w->left_margin_cols = w->right_margin_cols = Qnil; Fset_window_fringes (window, - B_ (b, left_fringe_width), B_ (b, right_fringe_width), - B_ (b, fringes_outside_margins)); + BVAR (b, left_fringe_width), BVAR (b, right_fringe_width), + BVAR (b, fringes_outside_margins)); Fset_window_scroll_bars (window, - B_ (b, scroll_bar_width), - B_ (b, vertical_scroll_bar_type), Qnil); + BVAR (b, scroll_bar_width), + BVAR (b, vertical_scroll_bar_type), Qnil); w->left_margin_cols = save_left; w->right_margin_cols = save_right; Fset_window_margins (window, - B_ (b, left_margin_cols), B_ (b, right_margin_cols)); + BVAR (b, left_margin_cols), BVAR (b, right_margin_cols)); } if (run_hooks_p) @@ -3469,7 +3469,7 @@ XSETWINDOW (window, w); buffer = Fget_buffer (buffer_or_name); CHECK_BUFFER (buffer); - if (NILP (B_ (XBUFFER (buffer), name))) + if (NILP (BVAR (XBUFFER (buffer), name))) error ("Attempt to display deleted buffer"); tem = w->buffer; @@ -3481,7 +3481,7 @@ if (EQ (tem, buffer)) return Qnil; else if (EQ (w->dedicated, Qt)) - error ("Window is dedicated to `%s'", SDATA (B_ (XBUFFER (tem), name))); + error ("Window is dedicated to `%s'", SDATA (BVAR (XBUFFER (tem), name))); else w->dedicated = Qnil; @@ -3552,7 +3552,7 @@ Fset_buffer (w->buffer); - B_ (XBUFFER (w->buffer), last_selected_window) = window; + BVAR (XBUFFER (w->buffer), last_selected_window) = window; /* Go to the point recorded in the window. This is important when the buffer is in more @@ -3640,7 +3640,7 @@ if (STRINGP (object)) object = Fget_buffer (object); - if (BUFFERP (object) && !NILP (B_ (XBUFFER (object), name))) + if (BUFFERP (object) && !NILP (BVAR (XBUFFER (object), name))) { /* Walk all windows looking for buffer, and force update of each of those windows. */ @@ -3663,7 +3663,7 @@ register Lisp_Object window; register struct window *w; - B_ (XBUFFER (buf), directory) = B_ (current_buffer, directory); + BVAR (XBUFFER (buf), directory) = BVAR (current_buffer, directory); Fset_buffer (buf); BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; @@ -5878,7 +5878,7 @@ saved_windows = XVECTOR (data->saved_windows); new_current_buffer = data->current_buffer; - if (NILP (B_ (XBUFFER (new_current_buffer), name))) + if (NILP (BVAR (XBUFFER (new_current_buffer), name))) new_current_buffer = Qnil; else { @@ -6063,14 +6063,14 @@ w->buffer = p->buffer; else { - if (!NILP (B_ (XBUFFER (p->buffer), name))) + if (!NILP (BVAR (XBUFFER (p->buffer), name))) /* If saved buffer is alive, install it. */ { w->buffer = p->buffer; w->start_at_line_beg = p->start_at_line_beg; set_marker_restricted (w->start, p->start, w->buffer); set_marker_restricted (w->pointm, p->pointm, w->buffer); - Fset_marker (B_ (XBUFFER (w->buffer), mark), + Fset_marker (BVAR (XBUFFER (w->buffer), mark), p->mark, w->buffer); /* As documented in Fcurrent_window_configuration, don't @@ -6080,7 +6080,7 @@ && XBUFFER (p->buffer) == current_buffer) Fgoto_char (w->pointm); } - else if (NILP (w->buffer) || NILP (B_ (XBUFFER (w->buffer), name))) + else if (NILP (w->buffer) || NILP (BVAR (XBUFFER (w->buffer), name))) /* Else unless window has a live buffer, get one. */ { w->buffer = Fcdr (Fcar (Vbuffer_alist)); @@ -6121,7 +6121,7 @@ has been restored into it. We already swapped out that point from that window's old buffer. */ select_window (data->current_window, Qnil, 1); - B_ (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) + BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) = selected_window; if (NILP (data->focus_frame) @@ -6322,7 +6322,7 @@ p->start = Fcopy_marker (w->start, Qnil); p->start_at_line_beg = w->start_at_line_beg; - tem = B_ (XBUFFER (w->buffer), mark); + tem = BVAR (XBUFFER (w->buffer), mark); p->mark = Fcopy_marker (tem, Qnil); } else === modified file 'src/xdisp.c' --- src/xdisp.c 2011-02-16 08:39:19 +0000 +++ src/xdisp.c 2011-02-16 15:02:50 +0000 @@ -1210,12 +1210,12 @@ if (WINDOW_WANTS_MODELINE_P (w)) current_mode_line_height = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), - B_ (current_buffer, mode_line_format)); + BVAR (current_buffer, mode_line_format)); if (WINDOW_WANTS_HEADER_LINE_P (w)) current_header_line_height = display_mode_line (w, HEADER_LINE_FACE_ID, - B_ (current_buffer, header_line_format)); + BVAR (current_buffer, header_line_format)); start_display (&it, w, top); move_it_to (&it, charpos, -1, it.last_visible_y-1, -1, @@ -2405,10 +2405,10 @@ if (base_face_id == DEFAULT_FACE_ID && FRAME_WINDOW_P (it->f)) { - if (NATNUMP (B_ (current_buffer, extra_line_spacing))) - it->extra_line_spacing = XFASTINT (B_ (current_buffer, extra_line_spacing)); - else if (FLOATP (B_ (current_buffer, extra_line_spacing))) - it->extra_line_spacing = (XFLOAT_DATA (B_ (current_buffer, extra_line_spacing)) + if (NATNUMP (BVAR (current_buffer, extra_line_spacing))) + it->extra_line_spacing = XFASTINT (BVAR (current_buffer, extra_line_spacing)); + else if (FLOATP (BVAR (current_buffer, extra_line_spacing))) + it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) * FRAME_LINE_HEIGHT (it->f)); else if (it->f->extra_line_spacing > 0) it->extra_line_spacing = it->f->extra_line_spacing; @@ -2431,36 +2431,36 @@ it->override_ascent = -1; /* Are control characters displayed as `^C'? */ - it->ctl_arrow_p = !NILP (B_ (current_buffer, ctl_arrow)); + it->ctl_arrow_p = !NILP (BVAR (current_buffer, ctl_arrow)); /* -1 means everything between a CR and the following line end is invisible. >0 means lines indented more than this value are invisible. */ - it->selective = (INTEGERP (B_ (current_buffer, selective_display)) - ? XFASTINT (B_ (current_buffer, selective_display)) - : (!NILP (B_ (current_buffer, selective_display)) + it->selective = (INTEGERP (BVAR (current_buffer, selective_display)) + ? XFASTINT (BVAR (current_buffer, selective_display)) + : (!NILP (BVAR (current_buffer, selective_display)) ? -1 : 0)); it->selective_display_ellipsis_p - = !NILP (B_ (current_buffer, selective_display_ellipses)); + = !NILP (BVAR (current_buffer, selective_display_ellipses)); /* Display table to use. */ it->dp = window_display_table (w); /* Are multibyte characters enabled in current_buffer? */ - it->multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); + it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); /* Do we need to reorder bidirectional text? Not if this is a unibyte buffer: by definition, none of the single-byte characters are strong R2L, so no reordering is needed. And bidi.c doesn't support unibyte buffers anyway. */ it->bidi_p - = !NILP (B_ (current_buffer, bidi_display_reordering)) && it->multibyte_p; + = !NILP (BVAR (current_buffer, bidi_display_reordering)) && it->multibyte_p; /* Non-zero if we should highlight the region. */ highlight_region_p = (!NILP (Vtransient_mark_mode) - && !NILP (B_ (current_buffer, mark_active)) - && XMARKER (B_ (current_buffer, mark))->buffer != 0); + && !NILP (BVAR (current_buffer, mark_active)) + && XMARKER (BVAR (current_buffer, mark))->buffer != 0); /* Set IT->region_beg_charpos and IT->region_end_charpos to the start and end of a visible region in window IT->w. Set both to @@ -2477,7 +2477,7 @@ && WINDOWP (minibuf_selected_window) && w == XWINDOW (minibuf_selected_window)))) { - EMACS_INT charpos = marker_position (B_ (current_buffer, mark)); + EMACS_INT charpos = marker_position (BVAR (current_buffer, mark)); it->region_beg_charpos = min (PT, charpos); it->region_end_charpos = max (PT, charpos); } @@ -2494,7 +2494,7 @@ it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger); /* Correct bogus values of tab_width. */ - it->tab_width = XINT (B_ (current_buffer, tab_width)); + it->tab_width = XINT (BVAR (current_buffer, tab_width)); if (it->tab_width <= 0 || it->tab_width > 1000) it->tab_width = 8; @@ -2508,8 +2508,8 @@ && (WINDOW_TOTAL_COLS (it->w) < XINT (Vtruncate_partial_width_windows)))))) it->line_wrap = TRUNCATE; - else if (NILP (B_ (current_buffer, truncate_lines))) - it->line_wrap = NILP (B_ (current_buffer, word_wrap)) + else if (NILP (BVAR (current_buffer, truncate_lines))) + it->line_wrap = NILP (BVAR (current_buffer, word_wrap)) ? WINDOW_WRAP : WORD_WRAP; else it->line_wrap = TRUNCATE; @@ -2611,9 +2611,9 @@ { /* Note the paragraph direction that this buffer wants to use. */ - if (EQ (B_ (current_buffer, bidi_paragraph_direction), Qleft_to_right)) + if (EQ (BVAR (current_buffer, bidi_paragraph_direction), Qleft_to_right)) it->paragraph_embedding = L2R; - else if (EQ (B_ (current_buffer, bidi_paragraph_direction), Qright_to_left)) + else if (EQ (BVAR (current_buffer, bidi_paragraph_direction), Qright_to_left)) it->paragraph_embedding = R2L; else it->paragraph_embedding = NEUTRAL_DIR; @@ -5411,7 +5411,7 @@ it->method = GET_FROM_BUFFER; it->object = it->w->buffer; it->area = TEXT_AREA; - it->multibyte_p = !NILP (B_ (current_buffer, enable_multibyte_characters)); + it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); it->sp = 0; it->string_from_display_prop_p = 0; it->face_before_selective_p = 0; @@ -7919,7 +7919,7 @@ old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); - B_ (current_buffer, undo_list) = Qt; + BVAR (current_buffer, undo_list) = Qt; oldpoint = message_dolog_marker1; set_marker_restricted (oldpoint, make_number (PT), Qnil); @@ -7943,7 +7943,7 @@ /* Insert the string--maybe converting multibyte to single byte or vice versa, so that all the text fits the buffer. */ if (multibyte - && NILP (B_ (current_buffer, enable_multibyte_characters))) + && NILP (BVAR (current_buffer, enable_multibyte_characters))) { EMACS_INT i; int c, char_bytes; @@ -7961,7 +7961,7 @@ } } else if (! multibyte - && ! NILP (B_ (current_buffer, enable_multibyte_characters))) + && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) { EMACS_INT i; int c, char_bytes; @@ -8460,7 +8460,7 @@ Lisp_Object string; string = Fcurrent_message (); message3 (string, SBYTES (string), - !NILP (B_ (current_buffer, enable_multibyte_characters))); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); } } @@ -8475,7 +8475,7 @@ for (i = 0; i < 2; ++i) if (!BUFFERP (echo_buffer[i]) - || NILP (B_ (XBUFFER (echo_buffer[i]), name))) + || NILP (BVAR (XBUFFER (echo_buffer[i]), name))) { char name[30]; Lisp_Object old_buffer; @@ -8484,7 +8484,7 @@ old_buffer = echo_buffer[i]; sprintf (name, " *Echo Area %d*", i); echo_buffer[i] = Fget_buffer_create (build_string (name)); - B_ (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; + BVAR (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; /* to force word wrap in echo area - it was decided to postpone this*/ /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ @@ -8577,8 +8577,8 @@ set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); } - B_ (current_buffer, undo_list) = Qt; - B_ (current_buffer, read_only) = Qnil; + BVAR (current_buffer, undo_list) = Qt; + BVAR (current_buffer, read_only) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -8691,7 +8691,7 @@ /* Switch to that buffer and clear it. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - B_ (current_buffer, truncate_lines) = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; if (Z > BEG) { @@ -8705,7 +8705,7 @@ /* Set up the buffer for the multibyteness we need. */ if (multibyte_p - != !NILP (B_ (current_buffer, enable_multibyte_characters))) + != !NILP (BVAR (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (multibyte_p ? Qt : Qnil); /* Raise the frame containing the echo area. */ @@ -8734,7 +8734,7 @@ { /* Someone switched buffers between print requests. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - B_ (current_buffer, truncate_lines) = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; } } } @@ -9177,12 +9177,12 @@ /* Change multibyteness of the echo buffer appropriately. */ if (message_enable_multibyte - != !NILP (B_ (current_buffer, enable_multibyte_characters))) + != !NILP (BVAR (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); - B_ (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; - if (!NILP (B_ (current_buffer, bidi_display_reordering))) - B_ (current_buffer, bidi_paragraph_direction) = Qleft_to_right; + BVAR (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; + if (!NILP (BVAR (current_buffer, bidi_display_reordering))) + BVAR (current_buffer, bidi_paragraph_direction) = Qleft_to_right; /* Insert new message at BEG. */ TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -9205,7 +9205,7 @@ if (nbytes == 0) nbytes = strlen (s); - if (multibyte_p && NILP (B_ (current_buffer, enable_multibyte_characters))) + if (multibyte_p && NILP (BVAR (current_buffer, enable_multibyte_characters))) { /* Convert from multi-byte to single-byte. */ EMACS_INT i; @@ -9223,7 +9223,7 @@ } } else if (!multibyte_p - && !NILP (B_ (current_buffer, enable_multibyte_characters))) + && !NILP (BVAR (current_buffer, enable_multibyte_characters))) { /* Convert from single-byte to multi-byte. */ EMACS_INT i; @@ -9808,7 +9808,7 @@ < BUF_MODIFF (XBUFFER (w->buffer))) != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) - && !NILP (B_ (XBUFFER (w->buffer), mark_active))) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; @@ -10006,7 +10006,7 @@ < BUF_MODIFF (XBUFFER (w->buffer))) != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) - && !NILP (B_ (XBUFFER (w->buffer), mark_active))) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; @@ -11097,8 +11097,8 @@ /* If selective display, can't optimize if changes start at the beginning of the line. */ if (unchanged_p - && INTEGERP (B_ (current_buffer, selective_display)) - && XINT (B_ (current_buffer, selective_display)) > 0 + && INTEGERP (BVAR (current_buffer, selective_display)) + && XINT (BVAR (current_buffer, selective_display)) > 0 && (BEG_UNCHANGED < start || GPT <= start)) unchanged_p = 0; @@ -11126,8 +11126,8 @@ require to redisplay the whole paragraph. It might be worthwhile to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization. */ - if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) - && NILP (B_ (XBUFFER (w->buffer), bidi_paragraph_direction))) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) unchanged_p = 0; } @@ -11674,11 +11674,11 @@ the whole window. The assignment to this_line_start_pos prevents the optimization directly below this if-statement. */ if (((!NILP (Vtransient_mark_mode) - && !NILP (B_ (XBUFFER (w->buffer), mark_active))) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing)) || (!NILP (w->region_showing) && !EQ (w->region_showing, - Fmarker_position (B_ (XBUFFER (w->buffer), mark))))) + Fmarker_position (BVAR (XBUFFER (w->buffer), mark))))) CHARPOS (this_line_start_pos) = 0; /* Optimize the case that only the line containing the cursor in the @@ -11842,8 +11842,8 @@ /* If highlighting the region, or if the cursor is in the echo area, then we can't just move the cursor. */ else if (! (!NILP (Vtransient_mark_mode) - && !NILP (B_ (current_buffer, mark_active))) - && (EQ (selected_window, B_ (current_buffer, last_selected_window)) + && !NILP (BVAR (current_buffer, mark_active))) + && (EQ (selected_window, BVAR (current_buffer, last_selected_window)) || highlight_nonselected_windows) && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) @@ -13050,8 +13050,8 @@ scroll_max = (max (scroll_step, max (arg_scroll_conservatively, temp_scroll_step)) * FRAME_LINE_HEIGHT (f)); - else if (NUMBERP (B_ (current_buffer, scroll_down_aggressively)) - || NUMBERP (B_ (current_buffer, scroll_up_aggressively))) + else if (NUMBERP (BVAR (current_buffer, scroll_down_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_up_aggressively))) /* We're trying to scroll because of aggressive scrolling but no scroll_step is set. Choose an arbitrary one. */ scroll_max = 10 * FRAME_LINE_HEIGHT (f); @@ -13116,7 +13116,7 @@ amount_to_scroll = scroll_max; else { - aggressive = B_ (current_buffer, scroll_up_aggressively); + aggressive = BVAR (current_buffer, scroll_up_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); if (NUMBERP (aggressive)) { @@ -13199,7 +13199,7 @@ amount_to_scroll = scroll_max; else { - aggressive = B_ (current_buffer, scroll_down_aggressively); + aggressive = BVAR (current_buffer, scroll_down_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); if (NUMBERP (aggressive)) { @@ -13380,7 +13380,7 @@ region exists, cursor movement has to do more than just set the cursor. */ && !(!NILP (Vtransient_mark_mode) - && !NILP (B_ (current_buffer, mark_active))) + && !NILP (BVAR (current_buffer, mark_active))) && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) /* Right after splitting windows, last_point may be nil. */ @@ -13535,7 +13535,7 @@ must_scroll = 1; } else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) + && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { /* If rows are bidi-reordered and point moved, back up until we find a row that does not belong to a @@ -13593,7 +13593,7 @@ else if (scroll_p) rc = CURSOR_MOVEMENT_MUST_SCROLL; else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) + && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { /* With bidi-reordered rows, there could be more than one candidate row whose start and end positions @@ -13893,7 +13893,7 @@ struct Lisp_Char_Table *disptab = buffer_display_table (); if (! disptab_matches_widthtab (disptab, - XVECTOR (B_ (current_buffer, width_table)))) + XVECTOR (BVAR (current_buffer, width_table)))) { invalidate_region_cache (current_buffer, current_buffer->width_run_cache, @@ -14015,7 +14015,7 @@ /* If we are highlighting the region, then we just changed the region, so redisplay to show it. */ if (!NILP (Vtransient_mark_mode) - && !NILP (B_ (current_buffer, mark_active))) + && !NILP (BVAR (current_buffer, mark_active))) { clear_glyph_matrix (w->desired_matrix); if (!try_window (window, startp, 0)) @@ -14178,8 +14178,8 @@ if ((scroll_conservatively || emacs_scroll_step || temp_scroll_step - || NUMBERP (B_ (current_buffer, scroll_up_aggressively)) - || NUMBERP (B_ (current_buffer, scroll_down_aggressively))) + || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_down_aggressively))) && !current_buffer->clip_changed && CHARPOS (startp) >= BEGV && CHARPOS (startp) <= ZV) @@ -14622,7 +14622,7 @@ /* Can't do this if region may have changed. */ if ((!NILP (Vtransient_mark_mode) - && !NILP (B_ (current_buffer, mark_active))) + && !NILP (BVAR (current_buffer, mark_active))) || !NILP (w->region_showing) || !NILP (Vshow_trailing_whitespace)) return 0; @@ -14965,7 +14965,7 @@ /* Can't use this optimization with bidi-reordered glyph rows, unless cursor is already at point. */ - if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering))) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { if (!(w->cursor.hpos >= 0 && w->cursor.hpos < row->used[TEXT_AREA] @@ -15279,7 +15279,7 @@ { struct glyph *g; - if (NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) + if (NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) || (!best_row && !row->continued_p)) return row; /* In bidi-reordered rows, there could be several rows @@ -15426,7 +15426,7 @@ /* Can't use this if highlighting a region because a cursor movement will do more than just set the cursor. */ if (!NILP (Vtransient_mark_mode) - && !NILP (B_ (current_buffer, mark_active))) + && !NILP (BVAR (current_buffer, mark_active))) GIVE_UP (9); /* Likewise if highlighting trailing whitespace. */ @@ -15446,7 +15446,7 @@ wrapped line can change the wrap position, altering the line above it. It might be worthwhile to handle this more intelligently, but for now just redisplay from scratch. */ - if (!NILP (B_ (XBUFFER (w->buffer), word_wrap))) + if (!NILP (BVAR (XBUFFER (w->buffer), word_wrap))) GIVE_UP (21); /* Under bidi reordering, adding or deleting a character in the @@ -15457,8 +15457,8 @@ to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization and redisplay from scratch. */ - if (!NILP (B_ (XBUFFER (w->buffer), bidi_display_reordering)) - && NILP (B_ (XBUFFER (w->buffer), bidi_paragraph_direction))) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) GIVE_UP (22); /* Make sure beg_unchanged and end_unchanged are up to date. Do it @@ -16429,7 +16429,7 @@ it.glyph_row->used[TEXT_AREA] = 0; SET_TEXT_POS (it.position, 0, 0); - multibyte_p = !NILP (B_ (buffer, enable_multibyte_characters)); + multibyte_p = !NILP (BVAR (buffer, enable_multibyte_characters)); p = arrow_string; while (p < arrow_end) { @@ -17364,7 +17364,7 @@ row->glyphs[TEXT_AREA]->charpos = -1; row->displays_text_p = 0; - if (!NILP (B_ (XBUFFER (it->w->buffer), indicate_empty_lines)) + if (!NILP (BVAR (XBUFFER (it->w->buffer), indicate_empty_lines)) && (!MINI_WINDOW_P (it->w) || (minibuf_level && EQ (it->window, minibuf_window)))) row->indicate_empty_line_p = 1; @@ -17942,10 +17942,10 @@ old = current_buffer; } - if (NILP (B_ (buf, bidi_display_reordering))) + if (NILP (BVAR (buf, bidi_display_reordering))) return Qleft_to_right; - else if (!NILP (B_ (buf, bidi_paragraph_direction))) - return B_ (buf, bidi_paragraph_direction); + else if (!NILP (BVAR (buf, bidi_paragraph_direction))) + return BVAR (buf, bidi_paragraph_direction); else { /* Determine the direction from buffer text. We could try to @@ -18204,14 +18204,14 @@ /* Select mode line face based on the real selected window. */ display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), - B_ (current_buffer, mode_line_format)); + BVAR (current_buffer, mode_line_format)); ++n; } if (WINDOW_WANTS_HEADER_LINE_P (w)) { display_mode_line (w, HEADER_LINE_FACE_ID, - B_ (current_buffer, header_line_format)); + BVAR (current_buffer, header_line_format)); ++n; } @@ -19146,7 +19146,7 @@ decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_flag) { Lisp_Object val; - int multibyte = !NILP (B_ (current_buffer, enable_multibyte_characters)); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); const unsigned char *eol_str; int eol_str_len; /* The EOL conversion we are using. */ @@ -19242,7 +19242,7 @@ switch (c) { case '*': - if (!NILP (B_ (b, read_only))) + if (!NILP (BVAR (b, read_only))) return "%"; if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; @@ -19252,7 +19252,7 @@ /* This differs from %* only for a modified read-only buffer. */ if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; - if (!NILP (B_ (b, read_only))) + if (!NILP (BVAR (b, read_only))) return "%"; return "-"; @@ -19314,7 +19314,7 @@ } case 'b': - obj = B_ (b, name); + obj = BVAR (b, name); break; case 'c': @@ -19354,7 +19354,7 @@ return "Emacs"; case 'f': - obj = B_ (b, filename); + obj = BVAR (b, filename); break; case 'i': @@ -19490,7 +19490,7 @@ break; case 'm': - obj = B_ (b, mode_name); + obj = BVAR (b, mode_name); break; case 'n': @@ -19575,7 +19575,7 @@ { int count = inhibit_garbage_collection (); Lisp_Object val = call1 (intern ("file-remote-p"), - B_ (current_buffer, directory)); + BVAR (current_buffer, directory)); unbind_to (count, Qnil); if (NILP (val)) @@ -19610,7 +19610,7 @@ (FRAME_TERMINAL_CODING (f)->id), p, 0); } - p = decode_mode_spec_coding (B_ (b, buffer_file_coding_system), + p = decode_mode_spec_coding (BVAR (b, buffer_file_coding_system), p, eol_flag); #if 0 /* This proves to be annoying; I think we can do without. -- rms. */ @@ -19660,8 +19660,8 @@ /* If we are not in selective display mode, check only for newlines. */ - int selective_display = (!NILP (B_ (current_buffer, selective_display)) - && !INTEGERP (B_ (current_buffer, selective_display))); + int selective_display = (!NILP (BVAR (current_buffer, selective_display)) + && !INTEGERP (BVAR (current_buffer, selective_display))); if (count > 0) { @@ -23308,13 +23308,13 @@ { if (w == XWINDOW (echo_area_window)) { - if (EQ (B_ (b, cursor_type), Qt) || NILP (B_ (b, cursor_type))) + if (EQ (BVAR (b, cursor_type), Qt) || NILP (BVAR (b, cursor_type))) { *width = FRAME_CURSOR_WIDTH (f); return FRAME_DESIRED_CURSOR (f); } else - return get_specified_cursor_type (B_ (b, cursor_type), width); + return get_specified_cursor_type (BVAR (b, cursor_type), width); } *active_cursor = 0; @@ -23334,23 +23334,23 @@ } /* Never display a cursor in a window in which cursor-type is nil. */ - if (NILP (B_ (b, cursor_type))) + if (NILP (BVAR (b, cursor_type))) return NO_CURSOR; /* Get the normal cursor type for this window. */ - if (EQ (B_ (b, cursor_type), Qt)) + if (EQ (BVAR (b, cursor_type), Qt)) { cursor_type = FRAME_DESIRED_CURSOR (f); *width = FRAME_CURSOR_WIDTH (f); } else - cursor_type = get_specified_cursor_type (B_ (b, cursor_type), width); + cursor_type = get_specified_cursor_type (BVAR (b, cursor_type), width); /* Use cursor-in-non-selected-windows instead for non-selected window or frame. */ if (non_selected) { - alt_cursor = B_ (b, cursor_in_non_selected_windows); + alt_cursor = BVAR (b, cursor_in_non_selected_windows); if (!EQ (Qt, alt_cursor)) return get_specified_cursor_type (alt_cursor, width); /* t means modify the normal cursor type. */ @@ -23397,7 +23397,7 @@ /* Cursor is blinked off, so determine how to "toggle" it. */ /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ - if ((alt_cursor = Fassoc (B_ (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) + if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) return get_specified_cursor_type (XCDR (alt_cursor), width); /* Then see if frame has specified a specific blink off cursor type. */ @@ -25513,11 +25513,11 @@ necessarily display the character whose position is the smallest. */ Lisp_Object lim1 = - NILP (B_ (XBUFFER (buffer), bidi_display_reordering)) + NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) ? Fmarker_position (w->start) : Qnil; Lisp_Object lim2 = - NILP (B_ (XBUFFER (buffer), bidi_display_reordering)) + NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) ? make_number (BUF_Z (XBUFFER (buffer)) - XFASTINT (w->window_end_pos)) : Qnil; === modified file 'src/xfaces.c' --- src/xfaces.c 2011-02-14 15:39:19 +0000 +++ src/xfaces.c 2011-02-16 15:02:50 +0000 @@ -5970,7 +5970,7 @@ { int face_id; - if (NILP (B_ (current_buffer, enable_multibyte_characters))) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) ch = 0; if (NILP (prop)) === modified file 'src/xfns.c' --- src/xfns.c 2011-02-14 15:39:19 +0000 +++ src/xfns.c 2011-02-16 15:02:50 +0000 @@ -4610,7 +4610,7 @@ Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - B_ (current_buffer, truncate_lines) = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5106,7 +5106,7 @@ /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); - B_ (current_buffer, truncate_lines) = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); ------------------------------------------------------------ revno: 103291 committer: Michael Albinus branch nick: trunk timestamp: Wed 2011-02-16 10:25:37 +0100 message: * net/soap-client.el: * net/soap-inspect.el: New files. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 08:51:39 +0000 +++ lisp/ChangeLog 2011-02-16 09:25:37 +0000 @@ -1,3 +1,8 @@ +2011-02-16 Alex Harsanyi + + * net/soap-client.el: + * net/soap-inspect.el: New files. + 2011-02-16 Leo * dired-x.el (dired-mode-map, dired-extra-startup): === added file 'lisp/net/soap-client.el' --- lisp/net/soap-client.el 1970-01-01 00:00:00 +0000 +++ lisp/net/soap-client.el 2011-02-16 09:25:37 +0000 @@ -0,0 +1,1694 @@ +;;;; soap.el -- Access SOAP web services from Emacs + +;; Copyright (C) 2009-2011 Alex Harsanyi + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) +;; Created: December, 2009 +;; Keywords: soap, web-services +;; Homepage: http://code.google.com/p/emacs-soap-client +;; + +;;; Commentary: +;; +;; To use the SOAP client, you first need to load the WSDL document for the +;; service you want to access, using `soap-load-wsdl-from-url'. A WSDL +;; document describes the available operations of the SOAP service, how their +;; parameters and responses are encoded. To invoke operations, you use the +;; `soap-invoke' method passing it the WSDL, the service name, the operation +;; you wish to invoke and any required parameters. +;; +;; Idealy, the service you want to access will have some documentation about +;; the operations it supports. If it does not, you can try using +;; `soap-inspect' to browse the WSDL document and see the available operations +;; and their parameters. +;; + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'xml) +(require 'warnings) +(require 'url) +(require 'url-http) +(require 'url-util) +(require 'mm-decode) + +(defsubst soap-warning (message &rest args) + "Display a warning MESSAGE with ARGS, using the 'soap-client warning type." + (display-warning 'soap-client (apply 'format message args) :warning)) + +(defgroup soap-client nil + "Access SOAP web services from Emacs." + :group 'tools) + +;;;; Support for parsing XML documents with namespaces + +;; XML documents with namespaces are difficult to parse because the names of +;; the nodes depend on what "xmlns" aliases have been defined in the document. +;; To work with such documents, we introduce a translation layer between a +;; "well known" namespace tag and the local namespace tag in the document +;; being parsed. + +(defconst *soap-well-known-xmlns* + '(("apachesoap" . "http://xml.apache.org/xml-soap") + ("soapenc" . "http://schemas.xmlsoap.org/soap/encoding/") + ("wsdl" . "http://schemas.xmlsoap.org/wsdl/") + ("wsdlsoap" . "http://schemas.xmlsoap.org/wsdl/soap/") + ("xsd" . "http://www.w3.org/2001/XMLSchema") + ("xsi" . "http://www.w3.org/2001/XMLSchema-instance") + ("soap" . "http://schemas.xmlsoap.org/soap/envelope/") + ("soap12" . "http://schemas.xmlsoap.org/wsdl/soap12/") + ("http" . "http://schemas.xmlsoap.org/wsdl/http/") + ("mime" . "http://schemas.xmlsoap.org/wsdl/mime/")) + "A list of well known xml namespaces and their aliases.") + +(defvar *soap-local-xmlns* nil + "A list of local namespace aliases. +This is a dynamically bound variable, controlled by +`soap-with-local-xmlns'.") + +(defvar *soap-default-xmlns* nil + "The default XML namespaces. +Names in this namespace will be unqualified. This is a +dynamically bound variable, controlled by +`soap-with-local-xmlns'") + +(defvar *soap-target-xmlns* nil + "The target XML namespace. +New XSD elements will be defined in this namespace, unless they +are fully qualified for a different namespace. This is a +dynamically bound variable, controlled by +`soap-with-local-xmlns'") + +(defun soap-wk2l (well-known-name) + "Return local variant of WELL-KNOWN-NAME. +This is done by looking up the namespace in the +`*soap-well-known-xmlns*' table and resolving the namespace to +the local name based on the current local translation table +`*soap-local-xmlns*'. See also `soap-with-local-xmlns'." + (let ((wk-name-1 (if (symbolp well-known-name) + (symbol-name well-known-name) + well-known-name))) + (cond + ((string-match "^\\(.*\\):\\(.*\\)$" wk-name-1) + (let ((ns (match-string 1 wk-name-1)) + (name (match-string 2 wk-name-1))) + (let ((namespace (cdr (assoc ns *soap-well-known-xmlns*)))) + (cond ((equal namespace *soap-default-xmlns*) + ;; Name is unqualified in the default namespace + (if (symbolp well-known-name) + (intern name) + name)) + (t + (let* ((local-ns (car (rassoc namespace *soap-local-xmlns*))) + (local-name (concat local-ns ":" name))) + (if (symbolp well-known-name) + (intern local-name) + local-name))))))) + (t well-known-name)))) + +(defun soap-l2wk (local-name) + "Convert LOCAL-NAME into a well known name. +The namespace of LOCAL-NAME is looked up in the +`*soap-well-known-xmlns*' table and a well known namespace tag is +used in the name. + +nil is returned if there is no well-known namespace for the +namespace of LOCAL-NAME." + (let ((l-name-1 (if (symbolp local-name) + (symbol-name local-name) + local-name)) + namespace name) + (cond + ((string-match "^\\(.*\\):\\(.*\\)$" l-name-1) + (setq name (match-string 2 l-name-1)) + (let ((ns (match-string 1 l-name-1))) + (setq namespace (cdr (assoc ns *soap-local-xmlns*))) + (unless namespace + (error "Soap-l2wk(%s): no namespace for alias %s" local-name ns)))) + (t + (setq name l-name-1) + (setq namespace *soap-default-xmlns*))) + + (if namespace + (let ((well-known-ns (car (rassoc namespace *soap-well-known-xmlns*)))) + (if well-known-ns + (let ((well-known-name (concat well-known-ns ":" name))) + (if (symbol-name local-name) + (intern well-known-name) + well-known-name)) + (progn + ;; (soap-warning "soap-l2wk(%s): namespace %s has no well-known tag" + ;; local-name namespace) + nil))) + ;; if no namespace is defined, just return the unqualified name + name))) + + +(defun soap-l2fq (local-name &optional use-tns) + "Convert LOCAL-NAME into a fully qualified name. +A fully qualified name is a cons of the namespace name and the +name of the element itself. For example \"xsd:string\" is +converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\" +\). + +The USE-TNS argument specifies what to do when LOCAL-NAME has no +namespace tag. If USE-TNS is non-nil, the `*soap-target-xmlns*' +will be used as the element's namespace, otherwise +`*soap-default-xmlns*' will be used. + +This is needed because different parts of a WSDL document can use +different namespace aliases for the same element." + (let ((local-name-1 (if (symbolp local-name) + (symbol-name local-name) + local-name))) + (cond ((string-match "^\\(.*\\):\\(.*\\)$" local-name-1) + (let ((ns (match-string 1 local-name-1)) + (name (match-string 2 local-name-1))) + (let ((namespace (cdr (assoc ns *soap-local-xmlns*)))) + (if namespace + (cons namespace name) + (error "Soap-l2fq(%s): unknown alias %s" local-name ns))))) + (t + (cons (if use-tns + *soap-target-xmlns* + *soap-default-xmlns*) + local-name))))) + +(defun soap-extract-xmlns (node &optional xmlns-table) + "Return a namespace alias table for NODE by extending XMLNS-TABLE." + (let (xmlns default-ns target-ns) + (dolist (a (xml-node-attributes node)) + (let ((name (symbol-name (car a))) + (value (cdr a))) + (cond ((string= name "targetNamespace") + (setq target-ns value)) + ((string= name "xmlns") + (setq default-ns value)) + ((string-match "^xmlns:\\(.*\\)$" name) + (push (cons (match-string 1 name) value) xmlns))))) + + (let ((tns (assoc "tns" xmlns))) + (cond ((and tns target-ns) + ;; If a tns alias is defined for this node, it must match the target + ;; namespace. + (unless (equal target-ns (cdr tns)) + (soap-warning "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch" + (xml-node-name node)))) + ((and tns (not target-ns)) + (setq target-ns (cdr tns))) + ((and (not tns) target-ns) + ;; a tns alias was not defined in this node. See if the node has + ;; a "targetNamespace" attribute and add an alias to this. Note + ;; that we might override an existing tns alias in XMLNS-TABLE, + ;; but that is intended. + (push (cons "tns" target-ns) xmlns)))) + + (list default-ns target-ns (append xmlns xmlns-table)))) + +(defmacro soap-with-local-xmlns (node &rest body) + "Install a local alias table from NODE and execute BODY." + (declare (debug (form &rest form)) (indent 1)) + (let ((xmlns (make-symbol "xmlns"))) + `(let ((,xmlns (soap-extract-xmlns ,node *soap-local-xmlns*))) + (let ((*soap-default-xmlns* (or (nth 0 ,xmlns) *soap-default-xmlns*)) + (*soap-target-xmlns* (or (nth 1 ,xmlns) *soap-target-xmlns*)) + (*soap-local-xmlns* (nth 2 ,xmlns))) + ,@body)))) + +(defun soap-get-target-namespace (node) + "Return the target namespace of NODE. +This is the namespace in which new elements will be defined." + (or (xml-get-attribute-or-nil node 'targetNamespace) + (cdr (assoc "tns" *soap-local-xmlns*)) + *soap-target-xmlns*)) + +(defun soap-xml-get-children1 (node child-name) + "Return the children of NODE named CHILD-NAME. +This is the same as `xml-get-children', but CHILD-NAME can have +namespace tag." + (let (result) + (dolist (c (xml-node-children node)) + (when (and (consp c) + (soap-with-local-xmlns c + ;; We use `ignore-errors' here because we want to silently + ;; skip nodes for which we cannot convert them to a + ;; well-known name. + (eq (ignore-errors (soap-l2wk (xml-node-name c))) child-name))) + (push c result))) + (nreverse result))) + +(defun soap-xml-get-attribute-or-nil1 (node attribute) + "Return the NODE's ATTRIBUTE, or nil if it does not exist. +This is the same as `xml-get-attribute-or-nil', but ATTRIBUTE can +be tagged with a namespace tag." + (catch 'found + (soap-with-local-xmlns node + (dolist (a (xml-node-attributes node)) + ;; We use `ignore-errors' here because we want to silently skip + ;; attributes for which we cannot convert them to a well-known name. + (when (eq (ignore-errors (soap-l2wk (car a))) attribute) + (throw 'found (cdr a))))))) + + +;;;; XML namespaces + +;; An element in an XML namespace, "things" stored in soap-xml-namespaces will +;; be derived from this object. + +(defstruct soap-element + name + ;; The "well-known" namespace tag for the element. For example, while + ;; parsing XML documents, we can have different tags for the XMLSchema + ;; namespace, but internally all our XMLSchema elements will have the "xsd" + ;; tag. + namespace-tag) + +(defun soap-element-fq-name (element) + "Return a fully qualified name for ELEMENT. +A fq name is the concatenation of the namespace tag and the +element name." + (concat (soap-element-namespace-tag element) + ":" (soap-element-name element))) + +;; a namespace link stores an alias for an object in once namespace to a +;; "target" object possibly in a different namespace + +(defstruct (soap-namespace-link (:include soap-element)) + target) + +;; A namespace is a collection of soap-element objects under a name (the name +;; of the namespace). + +(defstruct soap-namespace + (name nil :read-only t) ; e.g "http://xml.apache.org/xml-soap" + (elements (make-hash-table :test 'equal) :read-only t)) + +(defun soap-namespace-put (element ns) + "Store ELEMENT in NS. +Multiple elements with the same name can be stored in a +namespace. When retrieving the element you can specify a +discriminant predicate to `soap-namespace-get'" + (let ((name (soap-element-name element))) + (push element (gethash name (soap-namespace-elements ns))))) + +(defun soap-namespace-put-link (name target ns &optional replace) + "Store a link from NAME to TARGET in NS. +An error will be signaled if an element by the same name is +already present in NS, unless REPLACE is non nil. + +TARGET can be either a SOAP-ELEMENT or a string denoting an +element name into another namespace. + +If NAME is nil, an element with the same name as TARGET will be +added to the namespace." + + (unless (and name (not (equal name ""))) + ;; if name is nil, use TARGET as a name... + (cond ((soap-element-p target) + (setq name (soap-element-name target))) + ((stringp target) + (cond ((string-match "^\\(.*\\):\\(.*\\)$" target) + (setq name (match-string 2 target))) + (t + (setq name target)))))) + + (assert name) ; by now, name should be valid + (push (make-soap-namespace-link :name name :target target) + (gethash name (soap-namespace-elements ns)))) + +(defun soap-namespace-get (name ns &optional discriminant-predicate) + "Retrieve an element with NAME from the namespace NS. +If multiple elements with the same name exist, +DISCRIMINANT-PREDICATE is used to pick one of them. This allows +storing elements of different types (like a message type and a +binding) but the same name." + (assert (stringp name)) + (let ((elements (gethash name (soap-namespace-elements ns)))) + (cond (discriminant-predicate + (catch 'found + (dolist (e elements) + (when (funcall discriminant-predicate e) + (throw 'found e))))) + ((= (length elements) 1) (car elements)) + ((> (length elements) 1) + (error "Soap-namespace-get(%s): multiple elements, discriminant needed" name)) + (t + nil)))) + + +;;;; WSDL documents +;;;;; WSDL document elements + +(defstruct (soap-basic-type (:include soap-element)) + kind ; a symbol of: string, dateTime, long, int + ) + +(defstruct soap-sequence-element + name type nillable? multiple?) + +(defstruct (soap-sequence-type (:include soap-element)) + parent ; OPTIONAL WSDL-TYPE name + elements ; LIST of SOAP-SEQUCENCE-ELEMENT + ) + +(defstruct (soap-array-type (:include soap-element)) + element-type ; WSDL-TYPE of the array elements + ) + +(defstruct (soap-message (:include soap-element)) + parts ; ALIST of NAME => WSDL-TYPE name + ) + +(defstruct (soap-operation (:include soap-element)) + parameter-order + input ; (NAME . MESSAGE) + output ; (NAME . MESSAGE) + faults) ; a list of (NAME . MESSAGE) + +(defstruct (soap-port-type (:include soap-element)) + operations) ; a namespace of operations + +;; A bound operation is an operation which has a soap action and a use +;; method attached -- these are attached as part of a binding and we +;; can have different bindings for the same operations. +(defstruct soap-bound-operation + operation ; SOAP-OPERATION + soap-action ; value for SOAPAction HTTP header + use ; 'literal or 'encoded, see http://www.w3.org/TR/wsdl#_soap:body + ) + +(defstruct (soap-binding (:include soap-element)) + port-type + (operations (make-hash-table :test 'equal) :readonly t)) + +(defstruct (soap-port (:include soap-element)) + service-url + binding) + +(defun soap-default-xsd-types () + "Return a namespace containing some of the XMLSchema types." + (let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema"))) + (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" + "base64Binary" "anyType" "Array" "byte[]")) + (soap-namespace-put + (make-soap-basic-type :name type :kind (intern type)) + ns)) + ns)) + +(defun soap-default-soapenc-types () + "Return a namespace containing some of the SOAPEnc types." + (let ((ns (make-soap-namespace :name "http://schemas.xmlsoap.org/soap/encoding/"))) + (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" + "base64Binary" "anyType" "Array" "byte[]")) + (soap-namespace-put + (make-soap-basic-type :name type :kind (intern type)) + ns)) + ns)) + +(defun soap-type-p (element) + "Return t if ELEMENT is a SOAP data type (basic or complex)." + (or (soap-basic-type-p element) + (soap-sequence-type-p element) + (soap-array-type-p element))) + + +;;;;; The WSDL document + +;; The WSDL data structure used for encoding/decoding SOAP messages +(defstruct soap-wsdl + origin ; file or URL from which this wsdl was loaded + ports ; a list of SOAP-PORT instances + alias-table ; a list of namespace aliases + namespaces ; a list of namespaces + ) + +(defun soap-wsdl-add-alias (alias name wsdl) + "Add a namespace ALIAS for NAME to the WSDL document." + (push (cons alias name) (soap-wsdl-alias-table wsdl))) + +(defun soap-wsdl-find-namespace (name wsdl) + "Find a namespace by NAME in the WSDL document." + (catch 'found + (dolist (ns (soap-wsdl-namespaces wsdl)) + (when (equal name (soap-namespace-name ns)) + (throw 'found ns))))) + +(defun soap-wsdl-add-namespace (ns wsdl) + "Add the namespace NS to the WSDL document. +If a namespace by this name already exists in WSDL, individual +elements will be added to it." + (let ((existing (soap-wsdl-find-namespace (soap-namespace-name ns) wsdl))) + (if existing + ;; Add elements from NS to EXISTING, replacing existing values. + (maphash (lambda (key value) + (dolist (v value) + (soap-namespace-put v existing))) + (soap-namespace-elements ns)) + (push ns (soap-wsdl-namespaces wsdl))))) + +(defun soap-wsdl-get (name wsdl &optional predicate use-local-alias-table) + "Retrieve element NAME from the WSDL document. + +PREDICATE is used to differentiate between elements when NAME +refers to multiple elements. A typical value for this would be a +structure predicate for the type of element you want to retrieve. +For example, to retrieve a message named \"foo\" when other +elements named \"foo\" exist in the WSDL you could use: + + (soap-wsdl-get \"foo\" WSDL 'soap-message-p) + +If USE-LOCAL-ALIAS-TABLE is not nil, `*soap-local-xmlns*` will be +used to resolve the namespace alias." + (let ((alias-table (soap-wsdl-alias-table wsdl)) + namespace element-name element) + + (when (symbolp name) + (setq name (symbol-name name))) + + (when use-local-alias-table + (setq alias-table (append *soap-local-xmlns* alias-table))) + + (cond ((consp name) ; a fully qualified name, as returned by `soap-l2fq' + (setq element-name (cdr name)) + (when (symbolp element-name) + (setq element-name (symbol-name element-name))) + (setq namespace (soap-wsdl-find-namespace (car name) wsdl)) + (unless namespace + (error "Soap-wsdl-get(%s): unknown namespace: %s" name namespace))) + + ((string-match "^\\(.*\\):\\(.*\\)$" name) + (setq element-name (match-string 2 name)) + + (let* ((ns-alias (match-string 1 name)) + (ns-name (cdr (assoc ns-alias alias-table)))) + (unless ns-name + (error "Soap-wsdl-get(%s): cannot find namespace alias %s" name ns-alias)) + + (setq namespace (soap-wsdl-find-namespace ns-name wsdl)) + (unless namespace + (error "Soap-wsdl-get(%s): unknown namespace %s, referenced by alias %s" + name ns-name ns-alias)))) + (t + (error "Soap-wsdl-get(%s): bad name" name))) + + (setq element (soap-namespace-get + element-name namespace + (if predicate + (lambda (e) + (or (funcall 'soap-namespace-link-p e) + (funcall predicate e))) + nil))) + + (unless element + (error "Soap-wsdl-get(%s): cannot find element" name)) + + (if (soap-namespace-link-p element) + ;; NOTE: don't use the local alias table here + (soap-wsdl-get (soap-namespace-link-target element) wsdl predicate) + element))) + +;;;;; Resolving references for wsdl types + +;; See `soap-wsdl-resolve-references', which is the main entry point for +;; resolving references + +(defun soap-resolve-references-for-element (element wsdl) + "Resolve references in ELEMENT using the WSDL document. +This is a generic function which invokes a specific function +depending on the element type. + +If ELEMENT has no resolver function, it is silently ignored. + +All references are resolved in-place, that is the ELEMENT is +updated." + (let ((resolver (get (aref element 0) 'soap-resolve-references))) + (when resolver + (funcall resolver element wsdl)))) + +(defun soap-resolve-references-for-sequence-type (type wsdl) + "Resolve references for a sequence TYPE using WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let ((parent (soap-sequence-type-parent type))) + (when (or (consp parent) (stringp parent)) + (setf (soap-sequence-type-parent type) + (soap-wsdl-get parent wsdl 'soap-type-p)))) + (dolist (element (soap-sequence-type-elements type)) + (let ((element-type (soap-sequence-element-type element))) + (cond ((or (consp element-type) (stringp element-type)) + (setf (soap-sequence-element-type element) + (soap-wsdl-get element-type wsdl 'soap-type-p))) + ((soap-element-p element-type) + ;; since the element already has a child element, it + ;; could be an inline structure. we must resolve + ;; references in it, because it might not be reached by + ;; scanning the wsdl names. + (soap-resolve-references-for-element element-type wsdl)))))) + +(defun soap-resolve-references-for-array-type (type wsdl) + "Resolve references for an array TYPE using WSDL. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let ((element-type (soap-array-type-element-type type))) + (when (or (consp element-type) (stringp element-type)) + (setf (soap-array-type-element-type type) + (soap-wsdl-get element-type wsdl 'soap-type-p))))) + +(defun soap-resolve-references-for-message (message wsdl) + "Resolve references for a MESSAGE type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let (resolved-parts) + (dolist (part (soap-message-parts message)) + (let ((name (car part)) + (type (cdr part))) + (when (stringp name) + (setq name (intern name))) + (when (or (consp type) (stringp type)) + (setq type (soap-wsdl-get type wsdl 'soap-type-p))) + (push (cons name type) resolved-parts))) + (setf (soap-message-parts message) (nreverse resolved-parts)))) + +(defun soap-resolve-references-for-operation (operation wsdl) + "Resolve references for an OPERATION type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let ((input (soap-operation-input operation)) + (counter 0)) + (let ((name (car input)) + (message (cdr input))) + ;; Name this part if it was not named + (when (or (null name) (equal name "")) + (setq name (format "in%d" (incf counter)))) + (when (or (consp message) (stringp message)) + (setf (soap-operation-input operation) + (cons (intern name) (soap-wsdl-get message wsdl 'soap-message-p)))))) + + (let ((output (soap-operation-output operation)) + (counter 0)) + (let ((name (car output)) + (message (cdr output))) + (when (or (null name) (equal name "")) + (setq name (format "out%d" (incf counter)))) + (when (or (consp message) (stringp message)) + (setf (soap-operation-output operation) + (cons (intern name) (soap-wsdl-get message wsdl 'soap-message-p)))))) + + (let ((resolved-faults nil) + (counter 0)) + (dolist (fault (soap-operation-faults operation)) + (let ((name (car fault)) + (message (cdr fault))) + (when (or (null name) (equal name "")) + (setq name (format "fault%d" (incf counter)))) + (if (or (consp message) (stringp message)) + (push (cons (intern name) (soap-wsdl-get message wsdl 'soap-message-p)) + resolved-faults) + (push fault resolved-faults)))) + (setf (soap-operation-faults operation) resolved-faults)) + + (when (= (length (soap-operation-parameter-order operation)) 0) + (setf (soap-operation-parameter-order operation) + (mapcar 'car (soap-message-parts + (cdr (soap-operation-input operation)))))) + + (setf (soap-operation-parameter-order operation) + (mapcar (lambda (p) + (if (stringp p) + (intern p) + p)) + (soap-operation-parameter-order operation)))) + +(defun soap-resolve-references-for-binding (binding wsdl) + "Resolve references for a BINDING type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (when (or (consp (soap-binding-port-type binding)) + (stringp (soap-binding-port-type binding))) + (setf (soap-binding-port-type binding) + (soap-wsdl-get (soap-binding-port-type binding) wsdl 'soap-port-type-p))) + + (let ((port-ops (soap-port-type-operations (soap-binding-port-type binding)))) + (maphash (lambda (k v) + (setf (soap-bound-operation-operation v) + (soap-namespace-get k port-ops 'soap-operation-p))) + (soap-binding-operations binding)))) + +(defun soap-resolve-references-for-port (port wsdl) + "Resolve references for a PORT type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (when (or (consp (soap-port-binding port)) + (stringp (soap-port-binding port))) + (setf (soap-port-binding port) + (soap-wsdl-get (soap-port-binding port) wsdl 'soap-binding-p)))) + +;; Install resolvers for our types +(progn + (put (aref (make-soap-sequence-type) 0) 'soap-resolve-references + 'soap-resolve-references-for-sequence-type) + (put (aref (make-soap-array-type) 0) 'soap-resolve-references + 'soap-resolve-references-for-array-type) + (put (aref (make-soap-message) 0) 'soap-resolve-references + 'soap-resolve-references-for-message) + (put (aref (make-soap-operation) 0) 'soap-resolve-references + 'soap-resolve-references-for-operation) + (put (aref (make-soap-binding) 0) 'soap-resolve-references + 'soap-resolve-references-for-binding) + (put (aref (make-soap-port) 0) 'soap-resolve-references + 'soap-resolve-references-for-port)) + +(defun soap-wsdl-resolve-references (wsdl) + "Resolve all references inside the WSDL structure. + +When the WSDL elements are created from the XML document, they +refer to each other by name. For example, the ELEMENT-TYPE slot +of an SOAP-ARRAY-TYPE will contain the name of the element and +the user would have to call `soap-wsdl-get' to obtain the actual +element. + +After the entire document is loaded, we resolve all these +references to the actual elements they refer to so that at +runtime, we don't have to call `soap-wsdl-get' each time we +traverse an element tree." + (let ((nprocessed 0) + (nstag-id 0) + (alias-table (soap-wsdl-alias-table wsdl))) + (dolist (ns (soap-wsdl-namespaces wsdl)) + (let ((nstag (car-safe (rassoc (soap-namespace-name ns) alias-table)))) + (unless nstag + ;; If this namespace does not have an alias, create one for it. + (catch 'done + (while t + (setq nstag (format "ns%d" (incf nstag-id))) + (unless (assoc nstag alias-table) + (soap-wsdl-add-alias nstag (soap-namespace-name ns) wsdl) + (throw 'done t))))) + + (maphash (lambda (name element) + (cond ((soap-element-p element) ; skip links + (incf nprocessed) + (soap-resolve-references-for-element element wsdl) + (setf (soap-element-namespace-tag element) nstag)) + ((listp element) + (dolist (e element) + (when (soap-element-p e) + (incf nprocessed) + (soap-resolve-references-for-element e wsdl) + (setf (soap-element-namespace-tag e) nstag)))))) + (soap-namespace-elements ns)))) + + (message "Processed %d" nprocessed)) + wsdl) + +;;;;; Loading WSDL from XML documents + +(defun soap-load-wsdl-from-url (url) + "Load a WSDL document from URL and return it. +The returned WSDL document needs to be used for `soap-invoke' +calls." + (let ((url-request-method "GET") + (url-package-name "soap-client.el") + (url-package-version "1.0") + (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") + (url-request-coding-system 'utf-8) + (url-http-attempt-keepalives nil)) + (let ((buffer (url-retrieve-synchronously url))) + (with-current-buffer buffer + (declare (special url-http-response-status)) + (if (> url-http-response-status 299) + (error "Error retrieving WSDL: %s" url-http-response-status)) + (let ((mime-part (mm-dissect-buffer t t))) + (unless mime-part + (error "Failed to decode response from server")) + (unless (equal (car (mm-handle-type mime-part)) "text/xml") + (error "Server response is not an XML document")) + (with-temp-buffer + (mm-insert-part mime-part) + (let ((wsdl-xml (car (xml-parse-region (point-min) (point-max))))) + (prog1 + (let ((wsdl (soap-parse-wsdl wsdl-xml))) + (setf (soap-wsdl-origin wsdl) url) + wsdl) + (kill-buffer buffer))))))))) + +(defun soap-load-wsdl (file) + "Load a WSDL document from FILE and return it." + (with-temp-buffer + (insert-file-contents file) + (let ((xml (car (xml-parse-region (point-min) (point-max))))) + (let ((wsdl (soap-parse-wsdl xml))) + (setf (soap-wsdl-origin wsdl) file) + wsdl)))) + +(defun soap-parse-wsdl (node) + "Construct a WSDL structure from NODE, which is an XML document." + (soap-with-local-xmlns node + + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:definitions) + nil + "soap-parse-wsdl: expecting wsdl:definitions node, got %s" + (soap-l2wk (xml-node-name node))) + + (let ((wsdl (make-soap-wsdl))) + + ;; Add the local alias table to the wsdl document -- it will be used for + ;; all types in this document even after we finish parsing it. + (setf (soap-wsdl-alias-table wsdl) *soap-local-xmlns*) + + ;; Add the XSD types to the wsdl document + (let ((ns (soap-default-xsd-types))) + (soap-wsdl-add-namespace ns wsdl) + (soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl)) + + ;; Add the soapenc types to the wsdl document + (let ((ns (soap-default-soapenc-types))) + (soap-wsdl-add-namespace ns wsdl) + (soap-wsdl-add-alias "soapenc" (soap-namespace-name ns) wsdl)) + + ;; Find all the 'xsd:schema nodes which are children of wsdl:types nodes + ;; and build our type-library + + (let ((types (car (soap-xml-get-children1 node 'wsdl:types)))) + (dolist (node (xml-node-children types)) + ;; We cannot use (xml-get-children node (soap-wk2l 'xsd:schema)) + ;; because each node can install its own alias type so the schema + ;; nodes might have a different prefix. + (when (consp node) + (soap-with-local-xmlns node + (when (eq (soap-l2wk (xml-node-name node)) 'xsd:schema) + (soap-wsdl-add-namespace (soap-parse-schema node) wsdl)))))) + + (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) + (dolist (node (soap-xml-get-children1 node 'wsdl:message)) + (soap-namespace-put (soap-parse-message node) ns)) + + (dolist (node (soap-xml-get-children1 node 'wsdl:portType)) + (let ((port-type (soap-parse-port-type node))) + (soap-namespace-put port-type ns) + (soap-wsdl-add-namespace (soap-port-type-operations port-type) wsdl))) + + (dolist (node (soap-xml-get-children1 node 'wsdl:binding)) + (soap-namespace-put (soap-parse-binding node) ns)) + + (dolist (node (soap-xml-get-children1 node 'wsdl:service)) + (dolist (node (soap-xml-get-children1 node 'wsdl:port)) + (let ((name (xml-get-attribute node 'name)) + (binding (xml-get-attribute node 'binding)) + (url (let ((n (car (soap-xml-get-children1 node 'wsdlsoap:address)))) + (xml-get-attribute n 'location)))) + (let ((port (make-soap-port + :name name :binding (soap-l2fq binding 'tns) :service-url url))) + (soap-namespace-put port ns) + (push port (soap-wsdl-ports wsdl)))))) + + (soap-wsdl-add-namespace ns wsdl)) + + (soap-wsdl-resolve-references wsdl) + + wsdl))) + +(defun soap-parse-schema (node) + "Parse a schema NODE. +Return a SOAP-NAMESPACE containing the elements." + (soap-with-local-xmlns node + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema) + nil + "soap-parse-schema: expecting an xsd:schema node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) + ;; NOTE: we only extract the complexTypes from the schema, we wouldn't + ;; know how to handle basic types beyond the built in ones anyway. + (dolist (node (soap-xml-get-children1 node 'xsd:complexType)) + (soap-namespace-put (soap-parse-complex-type node) ns)) + + (dolist (node (soap-xml-get-children1 node 'xsd:element)) + (soap-namespace-put (soap-parse-schema-element node) ns)) + + ns))) + +(defun soap-parse-schema-element (node) + "Parse NODE and construct a schema element from it." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element) + nil + "soap-parse-schema-element: expecting xsd:element node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + type) + ;; A schema element that contains an inline complex type -- + ;; construct the actual complex type for it. + (let ((type-node (soap-xml-get-children1 node 'xsd:complexType))) + (when (> (length type-node) 0) + (assert (= (length type-node) 1)) ; only one complex type definition per element + (setq type (soap-parse-complex-type (car type-node))))) + (setf (soap-element-name type) name) + type)) + +(defun soap-parse-complex-type (node) + "Parse NODE and construct a complex type from it." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexType) + nil + "soap-parse-complex-type: expecting xsd:complexType node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + ;; Use a dummy type for the complex type, it will be replaced + ;; with the real type below, except when the complex type node + ;; is empty... + (type (make-soap-sequence-type :elements nil))) + (dolist (c (xml-node-children node)) + (when (consp c) ; skip string nodes, which are whitespace + (let ((node-name (soap-l2wk (xml-node-name c)))) + (cond + ((eq node-name 'xsd:sequence) + (setq type (soap-parse-complex-type-sequence c))) + ((eq node-name 'xsd:complexContent) + (setq type (soap-parse-complex-type-complex-content c))) + ((eq node-name 'xsd:attribute) + ;; The name of this node comes from an attribute tag + (let ((n (xml-get-attribute-or-nil c 'name))) + (setq name n))) + (t + (error "Unknown node type %s" node-name)))))) + (setf (soap-element-name type) name) + type)) + +(defun soap-parse-sequence (node) + "Parse NODE and a list of sequence elements that it defines. +NODE is assumed to be an xsd:sequence node. In that case, each +of its children is assumed to be a sequence element. Each +sequence element is parsed constructing the corresponding type. +A list of these types is returned." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:sequence) + nil + "soap-parse-sequence: expecting xsd:sequence node, got %s" + (soap-l2wk (xml-node-name node))) + (let (elements) + (dolist (e (soap-xml-get-children1 node 'xsd:element)) + (let ((name (xml-get-attribute-or-nil e 'name)) + (type (xml-get-attribute-or-nil e 'type)) + (nillable? (or (equal (xml-get-attribute-or-nil e 'nillable) "true") + (let ((e (xml-get-attribute-or-nil e 'minOccurs))) + (and e (equal e "0"))))) + (multiple? (let ((e (xml-get-attribute-or-nil e 'maxOccurs))) + (and e (not (equal e "1")))))) + (if type + (setq type (soap-l2fq type 'tns)) + + ;; The node does not have a type, maybe it has a complexType + ;; defined inline... + (let ((type-node (soap-xml-get-children1 e 'xsd:complexType))) + (when (> (length type-node) 0) + (assert (= (length type-node) 1) + nil + "only one complex type definition per element supported") + (setq type (soap-parse-complex-type (car type-node)))))) + + (push (make-soap-sequence-element + :name (intern name) :type type :nillable? nillable? :multiple? multiple?) + elements))) + (nreverse elements))) + +(defun soap-parse-complex-type-sequence (node) + "Parse NODE as a sequence type." + (let ((elements (soap-parse-sequence node))) + (make-soap-sequence-type :elements elements))) + +(defun soap-parse-complex-type-complex-content (node) + "Parse NODE as a xsd:complexContent node. +A sequence or an array type is returned depending on the actual +contents." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexContent) + nil + "soap-parse-complex-type-complex-content: expecting xsd:complexContent node, got %s" + (soap-l2wk (xml-node-name node))) + (let (array? parent elements) + (let ((extension (car-safe (soap-xml-get-children1 node 'xsd:extension))) + (restriction (car-safe (soap-xml-get-children1 node 'xsd:restriction)))) + ;; a complex content node is either an extension or a restriction + (cond (extension + (setq parent (xml-get-attribute-or-nil extension 'base)) + (setq elements (soap-parse-sequence + (car (soap-xml-get-children1 extension 'xsd:sequence))))) + (restriction + (let ((base (xml-get-attribute-or-nil restriction 'base))) + (assert (equal base "soapenc:Array") + nil + "restrictions supported only for soapenc:Array types, this is a %s" + base)) + (setq array? t) + (let ((attribute (car (soap-xml-get-children1 restriction 'xsd:attribute)))) + (let ((array-type (soap-xml-get-attribute-or-nil1 attribute 'wsdl:arrayType))) + (when (string-match "^\\(.*\\)\\[\\]$" array-type) + (setq parent (match-string 1 array-type)))))) + + (t + (error "Unknown complex type")))) + + (if parent + (setq parent (soap-l2fq parent 'tns))) + + (if array? + (make-soap-array-type :element-type parent) + (make-soap-sequence-type :parent parent :elements elements)))) + +(defun soap-parse-message (node) + "Parse NODE as a wsdl:message and return the corresponding type." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:message) + nil + "soap-parse-message: expecting wsdl:message node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + parts) + (dolist (p (soap-xml-get-children1 node 'wsdl:part)) + (let ((name (xml-get-attribute-or-nil p 'name)) + (type (xml-get-attribute-or-nil p 'type)) + (element (xml-get-attribute-or-nil p 'element))) + + (when type + (setq type (soap-l2fq type 'tns))) + + (when element + (setq element (soap-l2fq element 'tns))) + + (push (cons name (or type element)) parts))) + (make-soap-message :name name :parts (nreverse parts)))) + +(defun soap-parse-port-type (node) + "Parse NODE as a wsdl:portType and return the corresponding port." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:portType) + nil + "soap-parse-port-type: expecting wsdl:portType node got %s" + (soap-l2wk (xml-node-name node))) + (let ((ns (make-soap-namespace + :name (concat "urn:" (xml-get-attribute node 'name))))) + (dolist (node (soap-xml-get-children1 node 'wsdl:operation)) + (let ((o (soap-parse-operation node))) + + (let ((other-operation (soap-namespace-get (soap-element-name o) ns 'soap-operation-p))) + (if other-operation + ;; Unfortunately, the Confluence WSDL defines two operations + ;; named "search" which differ only in parameter names... + (soap-warning "Discarding duplicate operation: %s" (soap-element-name o)) + + (progn + (soap-namespace-put o ns) + + ;; link all messages from this namespace, as this namespace + ;; will be used for decoding the response. + (destructuring-bind (name . message) (soap-operation-input o) + (soap-namespace-put-link name message ns)) + + (destructuring-bind (name . message) (soap-operation-output o) + (soap-namespace-put-link name message ns)) + + (dolist (fault (soap-operation-faults o)) + (destructuring-bind (name . message) fault + (soap-namespace-put-link name message ns 'replace))) + + ))))) + + (make-soap-port-type :name (xml-get-attribute node 'name) + :operations ns))) + +(defun soap-parse-operation (node) + "Parse NODE as a wsdl:operation and return the corresponding type." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:operation) + nil + "soap-parse-operation: expecting wsdl:operation node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute node 'name)) + (parameter-order (split-string (xml-get-attribute node 'parameterOrder))) + input output faults) + (dolist (n (xml-node-children node)) + (when (consp n) ; skip string nodes which are whitespace + (let ((node-name (soap-l2wk (xml-node-name n)))) + (cond + ((eq node-name 'wsdl:input) + (let ((message (xml-get-attribute n 'message)) + (name (xml-get-attribute n 'name))) + (setq input (cons name (soap-l2fq message 'tns))))) + ((eq node-name 'wsdl:output) + (let ((message (xml-get-attribute n 'message)) + (name (xml-get-attribute n 'name))) + (setq output (cons name (soap-l2fq message 'tns))))) + ((eq node-name 'wsdl:fault) + (let ((message (xml-get-attribute n 'message)) + (name (xml-get-attribute n 'name))) + (push (cons name (soap-l2fq message 'tns)) faults))))))) + (make-soap-operation + :name name + :parameter-order parameter-order + :input input + :output output + :faults (nreverse faults)))) + +(defun soap-parse-binding (node) + "Parse NODE as a wsdl:binding and return the corresponding type." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:binding) + nil + "soap-parse-binding: expecting wsdl:binding node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute node 'name)) + (type (xml-get-attribute node 'type))) + (let ((binding (make-soap-binding :name name :port-type (soap-l2fq type 'tns)))) + (dolist (wo (soap-xml-get-children1 node 'wsdl:operation)) + (let ((name (xml-get-attribute wo 'name)) + soap-action + use) + (dolist (so (soap-xml-get-children1 wo 'wsdlsoap:operation)) + (setq soap-action (xml-get-attribute-or-nil so 'soapAction))) + + ;; Search a wsdlsoap:body node and find a "use" tag. The + ;; same use tag is assumed to be present for both input and + ;; output types (although the WDSL spec allows separate + ;; "use"-s for each of them... + + (dolist (i (soap-xml-get-children1 wo 'wsdl:input)) + (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body)) + (setq use (or use + (xml-get-attribute-or-nil b 'use))))) + + (unless use + (dolist (i (soap-xml-get-children1 wo 'wsdl:output)) + (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body)) + (setq use (or use + (xml-get-attribute-or-nil b 'use)))))) + + (puthash name (make-soap-bound-operation :operation name + :soap-action soap-action + :use (and use (intern use))) + (soap-binding-operations binding)))) + binding))) + +;;;; SOAP type decoding + +(defvar *soap-multi-refs* nil + "The list of multi-ref nodes in the current SOAP response. +This is a dynamically bound variable used during decoding the +SOAP response.") + +(defvar *soap-decoded-multi-refs* nil + "List of decoded multi-ref nodes in the current SOAP response. +This is a dynamically bound variable used during decoding the +SOAP response.") + +(defvar *soap-current-wsdl* nil + "The current WSDL document used when decoding the SOAP response. +This is a dynamically bound variable.") + +(defun soap-decode-type (type node) + "Use TYPE (an xsd type) to decode the contents of NODE. + +NODE is an XML node, representing some SOAP encoded value or a +reference to another XML node (a multiRef). This function will +resolve the multiRef reference, if any, than call a TYPE specific +decode function to perform the actual decoding." + (let ((href (xml-get-attribute-or-nil node 'href))) + (cond (href + (catch 'done + ;; NODE is actually a HREF, find the target and decode that. + ;; Check first if we already decoded this multiref. + + (let ((decoded (cdr (assoc href *soap-decoded-multi-refs*)))) + (when decoded + (throw 'done decoded))) + + (string-match "^#\\(.*\\)$" href) ; TODO: check that it matched + + (let ((id (match-string 1 href))) + (dolist (mr *soap-multi-refs*) + (let ((mrid (xml-get-attribute mr 'id))) + (when (equal id mrid) + ;; recurse here, in case there are multiple HREF's + (let ((decoded (soap-decode-type type mr))) + (push (cons href decoded) *soap-decoded-multi-refs*) + (throw 'done decoded))))) + (error "Cannot find href %s" href)))) + (t + (soap-with-local-xmlns node + (if (equal (soap-xml-get-attribute-or-nil1 node 'xsi:nil) "true") + nil + (let ((decoder (get (aref type 0) 'soap-decoder))) + (assert decoder nil "no soap-decoder for %s type" (aref type 0)) + (funcall decoder type node)))))))) + +(defun soap-decode-any-type (node) + "Decode NODE using type information inside it." + ;; If the NODE has type information, we use that... + (let ((type (soap-xml-get-attribute-or-nil1 node 'xsi:type))) + (if type + (let ((wtype (soap-wsdl-get type *soap-current-wsdl* 'soap-type-p))) + (if wtype + (soap-decode-type wtype node) + ;; The node has type info encoded in it, but we don't know how + ;; to decode it... + (error "Soap-decode-any-type: node has unknown type: %s" type))) + + ;; No type info in the node... + + (let ((contents (xml-node-children node))) + (if (and (= (length contents) 1) (stringp (car contents))) + ;; contents is just a string + (car contents) + + ;; we assume the NODE is a sequence with every element a + ;; structure name + (let (result) + (dolist (element contents) + (let ((key (xml-node-name element)) + (value (soap-decode-any-type element))) + (push (cons key value) result))) + (nreverse result))))))) + +(defun soap-decode-array (node) + "Decode NODE as an Array using type information inside it." + (let ((type (soap-xml-get-attribute-or-nil1 node 'soapenc:arrayType)) + (wtype nil) + (contents (xml-node-children node)) + result) + (when type + ;; Type is in the format "someType[NUM]" where NUM is the number of + ;; elements in the array. We discard the [NUM] part. + (setq type (replace-regexp-in-string "\\[[0-9]+\\]\\'" "" type)) + (setq wtype (soap-wsdl-get type *soap-current-wsdl* 'soap-type-p)) + (unless wtype + ;; The node has type info encoded in it, but we don't know how to + ;; decode it... + (error "Soap-decode-array: node has unknown type: %s" type))) + (dolist (e contents) + (when (consp e) + (push (if wtype + (soap-decode-type wtype e) + (soap-decode-any-type e)) + result))) + (nreverse result))) + +(defun soap-decode-basic-type (type node) + "Use TYPE to decode the contents of NODE. +TYPE is a `soap-basic-type' struct, and NODE is an XML document. +A LISP value is returned based on the contents of NODE and the +type-info stored in TYPE." + (let ((contents (xml-node-children node)) + (type-kind (soap-basic-type-kind type))) + + (if (null contents) + nil + (ecase type-kind + (string (car contents)) + (dateTime (car contents)) ; TODO: convert to a date time + ((long int float) (string-to-number (car contents))) + (boolean (string= (downcase (car contents)) "true")) + (base64Binary (base64-decode-string (car contents))) + (anyType (soap-decode-any-type node)) + (Array (soap-decode-array node)))))) + +(defun soap-decode-sequence-type (type node) + "Use TYPE to decode the contents of NODE. +TYPE is assumed to be a sequence type and an ALIST with the +contents of the NODE is returned." + (let ((result nil) + (parent (soap-sequence-type-parent type))) + (when parent + (setq result (nreverse (soap-decode-type parent node)))) + (dolist (element (soap-sequence-type-elements type)) + (let ((instance-count 0) + (e-name (soap-sequence-element-name element)) + (e-type (soap-sequence-element-type element))) + (dolist (node (xml-get-children node e-name)) + (incf instance-count) + (push (cons e-name (soap-decode-type e-type node)) result)) + ;; Do some sanity checking + (cond ((and (= instance-count 0) + (not (soap-sequence-element-nillable? element))) + (soap-warning "While decoding %s: missing non-nillable slot %s" + (soap-element-name type) e-name)) + ((and (> instance-count 1) + (not (soap-sequence-element-multiple? element))) + (soap-warning "While decoding %s: multiple slots named %s" + (soap-element-name type) e-name))))) + (nreverse result))) + +(defun soap-decode-array-type (type node) + "Use TYPE to decode the contents of NODE. +TYPE is assumed to be an array type. Arrays are decoded as lists. +This is because it is easier to work with list results in LISP." + (let ((result nil) + (element-type (soap-array-type-element-type type))) + (dolist (node (xml-node-children node)) + (when (consp node) + (push (soap-decode-type element-type node) result))) + (nreverse result))) + +(progn + (put (aref (make-soap-basic-type) 0) + 'soap-decoder 'soap-decode-basic-type) + (put (aref (make-soap-sequence-type) 0) + 'soap-decoder 'soap-decode-sequence-type) + (put (aref (make-soap-array-type) 0) + 'soap-decoder 'soap-decode-array-type)) + +;;;; Soap Envelope parsing + +(put 'soap-error + 'error-conditions + '(error soap-error)) +(put 'soap-error 'error-message "SOAP error") + +(defun soap-parse-envelope (node operation wsdl) + "Parse the SOAP envelope in NODE and return the response. +OPERATION is the WSDL operation for which we expect the response, +WSDL is used to decode the NODE" + (soap-with-local-xmlns node + (assert (eq (soap-l2wk (xml-node-name node)) 'soap:Envelope) + nil + "soap-parse-envelope: expecting soap:Envelope node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((body (car (soap-xml-get-children1 node 'soap:Body)))) + + (let ((fault (car (soap-xml-get-children1 body 'soap:Fault)))) + (when fault + (let ((fault-code (let ((n (car (xml-get-children fault 'faultcode)))) + (car-safe (xml-node-children n)))) + (fault-string (let ((n (car (xml-get-children fault 'faultstring)))) + (car-safe (xml-node-children n))))) + (while t + (signal 'soap-error (list fault-code fault-string)))))) + + ;; First (non string) element of the body is the root node of he + ;; response + (let ((response (if (eq (soap-bound-operation-use operation) 'literal) + ;; For 'literal uses, the response is the actual body + body + ;; ...otherwise the first non string element + ;; of the body is the response + (catch 'found + (dolist (n (xml-node-children body)) + (when (consp n) + (throw 'found n))))))) + (soap-parse-response response operation wsdl body))))) + +(defun soap-parse-response (response-node operation wsdl soap-body) + "Parse RESPONSE-NODE and return the result as a LISP value. +OPERATION is the WSDL operation for which we expect the response, +WSDL is used to decode the NODE. + +SOAP-BODY is the body of the SOAP envelope (of which +RESPONSE-NODE is a sub-node). It is used in case RESPONSE-NODE +reference multiRef parts which are external to RESPONSE-NODE." + (let* ((*soap-current-wsdl* wsdl) + (op (soap-bound-operation-operation operation)) + (use (soap-bound-operation-use operation)) + (message (cdr (soap-operation-output op)))) + + (soap-with-local-xmlns response-node + + (when (eq use 'encoded) + (let* ((received-message-name (soap-l2fq (xml-node-name response-node))) + (received-message (soap-wsdl-get received-message-name wsdl 'soap-message-p))) + (unless (eq received-message message) + (error "Unexpected message: got %s, expecting %s" + received-message-name + (soap-element-name message))))) + + (let ((decoded-parts nil) + (*soap-multi-refs* (xml-get-children soap-body 'multiRef)) + (*soap-decoded-multi-refs* nil)) + + (dolist (part (soap-message-parts message)) + (let ((tag (car part)) + (type (cdr part)) + node) + + (setq node + (cond + ((eq use 'encoded) + (car (xml-get-children response-node tag))) + + ((eq use 'literal) + (catch 'found + (let* ((ns-aliases (soap-wsdl-alias-table wsdl)) + (ns-name (cdr (assoc (soap-element-namespace-tag type) ns-aliases))) + (fqname (cons ns-name (soap-element-name type)))) + (dolist (c (xml-node-children response-node)) + (when (consp c) + (soap-with-local-xmlns c + (when (equal (soap-l2fq (xml-node-name c)) fqname) + (throw 'found c)))))))))) + + (unless node + (error "Soap-parse-response(%s): cannot find message part %s" + (soap-element-name op) tag)) + (push (soap-decode-type type node) decoded-parts))) + + decoded-parts)))) + +;;;; SOAP type encoding + +(defvar *soap-encoded-namespaces* nil + "A list of namespace tags used during encoding a message. +This list is populated by `soap-encode-value' and used by +`soap-create-envelope' to add aliases for these namespace to the +XML request. + +This variable is dynamically bound in `soap-create-envelope'.") + +(defun soap-encode-value (xml-tag value type) + "Encode inside an XML-TAG the VALUE using TYPE. +The resulting XML data is inserted in the current buffer +at (point)/ + +TYPE is one of the soap-*-type structures which defines how VALUE +is to be encoded. This is a generic function which finds an +encoder function based on TYPE and calls that encoder to do the +work." + (let ((encoder (get (aref type 0) 'soap-encoder))) + (assert encoder nil "no soap-encoder for %s type" (aref type 0)) + ;; XML-TAG can be a string or a symbol, but we pass only string's to the + ;; encoders + (when (symbolp xml-tag) + (setq xml-tag (symbol-name xml-tag))) + (funcall encoder xml-tag value type)) + (add-to-list '*soap-encoded-namespaces* (soap-element-namespace-tag type))) + +(defun soap-encode-basic-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE. +Do not call this function directly, use `soap-encode-value' +instead." + (let ((xsi-type (soap-element-fq-name type)) + (basic-type (soap-basic-type-kind type))) + + ;; try to classify the type based on the value type and use that type when + ;; encoding + (when (eq basic-type 'anyType) + (cond ((stringp value) + (setq xsi-type "xsd:string" basic-type 'string)) + ((integerp value) + (setq xsi-type "xsd:int" basic-type 'int)) + ((memq value '(t nil)) + (setq xsi-type "xsd:boolean" basic-type 'boolean)) + (t + (error "Soap-encode-basic-type(%s, %s, %s): cannot classify anyType value" + xml-tag value xsi-type)))) + + (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") + + ;; We have some ambiguity here, as a nil value represents "false" when the + ;; type is boolean, we will never have a "nil" boolean type... + + (if (or value (eq basic-type 'boolean)) + (progn + (insert ">") + (case basic-type + (string + (unless (stringp value) + (error "Soap-encode-basic-type(%s, %s, %s): not a string value" + xml-tag value xsi-type)) + (insert (url-insert-entities-in-string value))) + + (dateTime + (cond ((and (consp value) ; is there a time-value-p ? + (>= (length value) 2) + (numberp (nth 0 value)) + (numberp (nth 1 value))) + ;; Value is a (current-time) style value, convert to a string + (insert (format-time-string "%Y-%m-%dT%H:%M:%S" value))) + ((stringp value) + (insert (url-insert-entities-in-string value))) + (t + (error "Soap-encode-basic-type(%s, %s, %s): not a dateTime value" + xml-tag value xsi-type)))) + + (boolean + (unless (memq value '(t nil)) + (error "Soap-encode-basic-type(%s, %s, %s): not a boolean value" + xml-tag value xsi-type)) + (insert (if value "true" "false"))) + + ((long int) + (unless (integerp value) + (error "Soap-encode-basic-type(%s, %s, %s): not an integer value" + xml-tag value xsi-type)) + (insert (number-to-string value))) + + (base64Binary + (unless (stringp value) + (error "Soap-encode-basic-type(%s, %s, %s): not a string value" + xml-tag value xsi-type)) + (insert (base64-encode-string value))) + + (otherwise + (error "Soap-encode-basic-type(%s, %s, %s): don't know how to encode" + xml-tag value xsi-type)))) + + (insert " xsi:nil=\"true\">")) + (insert "\n"))) + +(defun soap-encode-sequence-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE. +Do not call this function directly, use `soap-encode-value' +instead." + (let ((xsi-type (soap-element-fq-name type))) + (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") + (if value + (progn + (insert ">\n") + (let ((parents (list type)) + (parent (soap-sequence-type-parent type))) + + (while parent + (push parent parents) + (setq parent (soap-sequence-type-parent parent))) + + (dolist (type parents) + (dolist (element (soap-sequence-type-elements type)) + (let ((instance-count 0) + (e-name (soap-sequence-element-name element)) + (e-type (soap-sequence-element-type element))) + (dolist (v value) + (when (equal (car v) e-name) + (incf instance-count) + (soap-encode-value e-name (cdr v) e-type))) + + ;; Do some sanity checking + (cond ((and (= instance-count 0) + (not (soap-sequence-element-nillable? element))) + (soap-warning "While encoding %s: missing non-nillable slot %s" + (soap-element-name type) e-name)) + ((and (> instance-count 1) + (not (soap-sequence-element-multiple? element))) + (soap-warning "While encoding %s: multiple slots named %s" + (soap-element-name type) e-name)))))))) + (insert " xsi:nil=\"true\">")) + (insert "\n"))) + +(defun soap-encode-array-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE. +Do not call this function directly, use `soap-encode-value' +instead." + (unless (vectorp value) + (error "Soap-encode: %s(%s) expects a vector, got: %s" + xml-tag (soap-element-fq-name type) value)) + (let* ((element-type (soap-array-type-element-type type)) + (array-type (concat (soap-element-fq-name element-type) + "[" (format "%s" (length value)) "]"))) + (insert "<" xml-tag + " soapenc:arrayType=\"" array-type "\" " + " xsi:type=\"soapenc:Array\">\n") + (loop for i below (length value) + do (soap-encode-value xml-tag (aref value i) element-type)) + (insert "\n"))) + +(progn + (put (aref (make-soap-basic-type) 0) + 'soap-encoder 'soap-encode-basic-type) + (put (aref (make-soap-sequence-type) 0) + 'soap-encoder 'soap-encode-sequence-type) + (put (aref (make-soap-array-type) 0) + 'soap-encoder 'soap-encode-array-type)) + +(defun soap-encode-body (operation parameters wsdl) + "Create the body of a SOAP request for OPERATION in the current buffer. +PARAMETERS is a list of parameters supplied to the OPERATION. + +The OPERATION and PARAMETERS are encoded according to the WSDL +document." + (let* ((op (soap-bound-operation-operation operation)) + (use (soap-bound-operation-use operation)) + (message (cdr (soap-operation-input op))) + (parameter-order (soap-operation-parameter-order op))) + + (unless (= (length parameter-order) (length parameters)) + (error "Wrong number of parameters for %s: expected %d, got %s" + (soap-element-name op) + (length parameter-order) + (length parameters))) + + (insert "\n") + (when (eq use 'encoded) + (add-to-list '*soap-encoded-namespaces* (soap-element-namespace-tag op)) + (insert "<" (soap-element-fq-name op) ">\n")) + + (let ((param-table (loop for formal in parameter-order + for value in parameters + collect (cons formal value)))) + (dolist (part (soap-message-parts message)) + (let* ((param-name (car part)) + (type (cdr part)) + (tag-name (if (eq use 'encoded) + param-name + (soap-element-name type))) + (value (cdr (assoc param-name param-table))) + (start-pos (point))) + (soap-encode-value tag-name value type) + (when (eq use 'literal) + ;; hack: add the xmlns attribute to the tag, the only way + ;; ASP.NET web services recognize the namespace of the + ;; element itself... + (save-excursion + (goto-char start-pos) + (when (re-search-forward " ") + (let* ((ns (soap-element-namespace-tag type)) + (namespace (cdr (assoc ns (soap-wsdl-alias-table wsdl))))) + (when namespace + (insert "xmlns=\"" namespace "\" "))))))))) + + (when (eq use 'encoded) + (insert "\n")) + (insert "\n"))) + +(defun soap-create-envelope (operation parameters wsdl) + "Create a SOAP request envelope for OPERATION using PARAMETERS. +WSDL is the wsdl document used to encode the PARAMETERS." + (with-temp-buffer + (let ((*soap-encoded-namespaces* '("xsi" "soap" "soapenc")) + (use (soap-bound-operation-use operation))) + + ;; Create the request body + (soap-encode-body operation parameters wsdl) + + ;; Put the envelope around the body + (goto-char (point-min)) + (insert "\n\n") + (goto-char (point-max)) + (insert "\n")) + + (buffer-string))) + +;;;; invoking soap methods + +(defcustom soap-debug nil + "When t, enable some debugging facilities." + :type 'boolean + :group 'soap-client) + +(defun soap-invoke (wsdl service operation-name &rest parameters) + "Invoke a SOAP operation and return the result. + +WSDL is used for encoding the request and decoding the response. +It also contains information about the WEB server address that +will service the request. + +SERVICE is the SOAP service to invoke. + +OPERATION-NAME is the operation to invoke. + +PARAMETERS -- the remaining parameters are used as parameters for +the SOAP request. + +NOTE: The SOAP service provider should document the available +operations and their parameters for the service. You can also +use the `soap-inspect' function to browse the available +operations in a WSDL document." + (let ((port (catch 'found + (dolist (p (soap-wsdl-ports wsdl)) + (when (equal service (soap-element-name p)) + (throw 'found p)))))) + (unless port + (error "Unknown SOAP service: %s" service)) + + (let* ((binding (soap-port-binding port)) + (operation (gethash operation-name (soap-binding-operations binding)))) + (unless operation + (error "No operation %s for SOAP service %s" operation-name service)) + + (let ((url-request-method "POST") + (url-package-name "soap-client.el") + (url-package-version "1.0") + (url-http-version "1.0") + (url-request-data (soap-create-envelope operation parameters wsdl)) + (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") + (url-request-coding-system 'utf-8) + (url-http-attempt-keepalives t) + (url-request-extra-headers (list + (cons "SOAPAction" (soap-bound-operation-soap-action operation)) + (cons "Content-Type" "text/xml; charset=utf-8")))) + (let ((buffer (url-retrieve-synchronously (soap-port-service-url port)))) + (condition-case err + (with-current-buffer buffer + (declare (special url-http-response-status)) + (if (null url-http-response-status) + (error "No HTTP response from server")) + (if (and soap-debug (> url-http-response-status 299)) + ;; This is a warning because some SOAP errors come + ;; back with a HTTP response 500 (internal server + ;; error) + (warn "Error in SOAP response: HTTP code %s" url-http-response-status)) + (when (> (buffer-size) 1000000) + (soap-warning "Received large message: %s bytes" (buffer-size))) + (let ((mime-part (mm-dissect-buffer t t))) + (unless mime-part + (error "Failed to decode response from server")) + (unless (equal (car (mm-handle-type mime-part)) "text/xml") + (error "Server response is not an XML document")) + (with-temp-buffer + (mm-insert-part mime-part) + (let ((response (car (xml-parse-region (point-min) (point-max))))) + (prog1 + (soap-parse-envelope response operation wsdl) + (kill-buffer buffer) + (mm-destroy-part mime-part)))))) + (soap-error + ;; Propagate soap-errors -- they are error replies of the + ;; SOAP protocol and don't indicate a communication + ;; problem or a bug in this code. + (signal (car err) (cdr err))) + (error + (when soap-debug + (pop-to-buffer buffer)) + (error (error-message-string err))))))))) + +(provide 'soap-client) + + +;;; Local Variables: +;;; mode: emacs-lisp +;;; mode: outline-minor +;;; outline-regexp: ";;;;+" +;;; End: + +;;; soap-client.el ends here === added file 'lisp/net/soap-inspect.el' --- lisp/net/soap-inspect.el 1970-01-01 00:00:00 +0000 +++ lisp/net/soap-inspect.el 2011-02-16 09:25:37 +0000 @@ -0,0 +1,352 @@ +;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures + +;; Copyright (C) 2010-2011 Alex Harsanyi + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) +;; Created: October 2010 +;; Keywords: soap, web-services +;; Homepage: http://code.google.com/p/emacs-soap-client +;; + +;;; Commentary: +;; +;; This package provides an inspector for a WSDL document loaded with +;; `soap-load-wsdl' or `soap-load-wsdl-from-url'. To use it, evaluate: +;; +;; (soap-inspect *wsdl*) +;; +;; This will pop-up the inspector buffer. You can click on ports, operations +;; and types to explore the structure of the wsdl document. +;; + +(require 'soap-client) + + +;;; Code: + +;;; sample-value + +(defun soap-sample-value (type) + "Provide a sample value for TYPE, a WSDL type. +A sample value is a LISP value which soap-client.el will accept +for encoding it using TYPE when making SOAP requests. + +This is a generic function, depending on TYPE a specific function +will be called." + (let ((sample-value (get (aref type 0) 'soap-sample-value))) + (if sample-value + (funcall sample-value type) + (error "Cannot provide sample value for type %s" (aref type 0))))) + +(defun soap-sample-value-for-basic-type (type) + "Provide a sample value for TYPE which is a basic type. +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (case (soap-basic-type-kind type) + (string "a string value") + (boolean t) ; could be nil as well + ((long int) (random 4200)) + ;; TODO: we need better sample values for more types. + (t (format "%s" (soap-basic-type-kind type))))) + +(defun soap-sample-value-for-seqence-type (type) + "Provide a sample value for TYPE which is a sequence type. +Values for sequence types are ALISTS of (slot-name . VALUE) for +each sequence element. + +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (let ((sample-value nil)) + (dolist (element (soap-sequence-type-elements type)) + (push (cons (soap-sequence-element-name element) + (soap-sample-value (soap-sequence-element-type element))) + sample-value)) + (when (soap-sequence-type-parent type) + (setq sample-value + (append (soap-sample-value (soap-sequence-type-parent type)) + sample-value))) + sample-value)) + +(defun soap-sample-value-for-array-type (type) + "Provide a sample value for TYPE which is an array type. +Values for array types are LISP vectors of values which are +array's element type. + +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (let* ((element-type (soap-array-type-element-type type)) + (sample1 (soap-sample-value element-type)) + (sample2 (soap-sample-value element-type))) + ;; Our sample value is a vector of two elements, but any number of + ;; elements are permissible + (vector sample1 sample2 '&etc))) + +(defun soap-sample-value-for-message (message) + "Provide a sample value for a WSDL MESSAGE. +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + ;; NOTE: parameter order is not considered. + (let (sample-value) + (dolist (part (soap-message-parts message)) + (push (cons (car part) + (soap-sample-value (cdr part))) + sample-value)) + (nreverse sample-value))) + +(progn + ;; Install soap-sample-value methods for our types + (put (aref (make-soap-basic-type) 0) 'soap-sample-value + 'soap-sample-value-for-basic-type) + + (put (aref (make-soap-sequence-type) 0) 'soap-sample-value + 'soap-sample-value-for-seqence-type) + + (put (aref (make-soap-array-type) 0) 'soap-sample-value + 'soap-sample-value-for-array-type) + + (put (aref (make-soap-message) 0) 'soap-sample-value + 'soap-sample-value-for-message) ) + + + +;;; soap-inspect + +(defvar soap-inspect-previous-items nil + "A stack of previously inspected items in the *soap-inspect* buffer. +Used to implement the BACK button.") + +(defvar soap-inspect-current-item nil + "The current item being inspected in the *soap-inspect* buffer.") + +(progn + (make-variable-buffer-local 'soap-inspect-previous-items) + (make-variable-buffer-local 'soap-inspect-current-item)) + +(defun soap-inspect (element) + "Inspect a SOAP ELEMENT in the *soap-inspect* buffer. +The buffer is populated with information about ELEMENT with links +to its sub elements. If ELEMENT is the WSDL document itself, the +entire WSDL can be inspected." + (let ((inspect (get (aref element 0) 'soap-inspect))) + (unless inspect + (error "Soap-inspect: no inspector for element")) + + (with-current-buffer (get-buffer-create "*soap-inspect*") + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + + (when soap-inspect-current-item + (push soap-inspect-current-item + soap-inspect-previous-items)) + (setq soap-inspect-current-item element) + + (funcall inspect element) + + (unless (null soap-inspect-previous-items) + (insert "\n\n") + (insert-text-button + "[back]" + 'type 'soap-client-describe-back-link + 'item element) + (insert "\n")) + (goto-char (point-min)) + (pop-to-buffer (current-buffer)))))) + + +(define-button-type 'soap-client-describe-link + 'face 'italic + 'help-echo "mouse-2, RET: describe item" + 'follow-link t + 'action (lambda (button) + (let ((item (button-get button 'item))) + (soap-inspect item))) + 'skip t) + +(define-button-type 'soap-client-describe-back-link + 'face 'italic + 'help-echo "mouse-2, RET: browse the previous item" + 'follow-link t + 'action (lambda (button) + (let ((item (pop soap-inspect-previous-items))) + (when item + (setq soap-inspect-current-item nil) + (soap-inspect item)))) + 'skip t) + +(defun soap-insert-describe-button (element) + "Insert a button to inspect ELEMENT when pressed." + (insert-text-button + (soap-element-fq-name element) + 'type 'soap-client-describe-link + 'item element)) + +(defun soap-inspect-basic-type (basic-type) + "Insert information about BASIC-TYPE into the current buffer." + (insert "Basic type: " (soap-element-fq-name basic-type)) + (insert "\nSample value\n") + (pp (soap-sample-value basic-type) (current-buffer))) + +(defun soap-inspect-sequence-type (sequence) + "Insert information about SEQUENCE into the current buffer." + (insert "Sequence type: " (soap-element-fq-name sequence) "\n") + (when (soap-sequence-type-parent sequence) + (insert "Parent: ") + (soap-insert-describe-button + (soap-sequence-type-parent sequence)) + (insert "\n")) + (insert "Elements: \n") + (dolist (element (soap-sequence-type-elements sequence)) + (insert "\t" (symbol-name (soap-sequence-element-name element)) + "\t") + (soap-insert-describe-button + (soap-sequence-element-type element)) + (when (soap-sequence-element-multiple? element) + (insert " multiple")) + (when (soap-sequence-element-nillable? element) + (insert " optional")) + (insert "\n")) + (insert "Sample value:\n") + (pp (soap-sample-value sequence) (current-buffer))) + +(defun soap-inspect-array-type (array) + "Insert information about the ARRAY into the current buffer." + (insert "Array name: " (soap-element-fq-name array) "\n") + (insert "Element type: ") + (soap-insert-describe-button + (soap-array-type-element-type array)) + (insert "\nSample value:\n") + (pp (soap-sample-value array) (current-buffer))) + +(defun soap-inspect-message (message) + "Insert information about MESSAGE into the current buffer." + (insert "Message name: " (soap-element-fq-name message) "\n") + (insert "Parts:\n") + (dolist (part (soap-message-parts message)) + (insert "\t" (symbol-name (car part)) + " type: ") + (soap-insert-describe-button (cdr part)) + (insert "\n"))) + +(defun soap-inspect-operation (operation) + "Insert information about OPERATION into the current buffer." + (insert "Operation name: " (soap-element-fq-name operation) "\n") + (let ((input (soap-operation-input operation))) + (insert "\tInput: " (symbol-name (car input)) " (" ) + (soap-insert-describe-button (cdr input)) + (insert ")\n")) + (let ((output (soap-operation-output operation))) + (insert "\tOutput: " (symbol-name (car output)) " (") + (soap-insert-describe-button (cdr output)) + (insert ")\n")) + + (insert "\n\nSample invocation:\n") + (let ((sample-message-value (soap-sample-value (cdr (soap-operation-input operation)))) + (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation)))) + (let ((sample-invocation (append funcall (mapcar 'cdr sample-message-value)))) + (pp sample-invocation (current-buffer))))) + +(defun soap-inspect-port-type (port-type) + "Insert information about PORT-TYPE into the current buffer." + (insert "Port-type name: " (soap-element-fq-name port-type) "\n") + (insert "Operations:\n") + (loop for o being the hash-values of + (soap-namespace-elements (soap-port-type-operations port-type)) + do (progn + (insert "\t") + (soap-insert-describe-button (car o))))) + +(defun soap-inspect-binding (binding) + "Insert information about BINDING into the current buffer." + (insert "Binding: " (soap-element-fq-name binding) "\n") + (insert "\n") + (insert "Bound operations:\n") + (let* ((ophash (soap-binding-operations binding)) + (operations (loop for o being the hash-keys of ophash + collect o)) + op-name-width) + + (setq operations (sort operations 'string<)) + + (setq op-name-width (loop for o in operations maximizing (length o))) + + (dolist (op operations) + (let* ((bound-op (gethash op ophash)) + (soap-action (soap-bound-operation-soap-action bound-op)) + (use (soap-bound-operation-use bound-op))) + (unless soap-action + (setq soap-action "")) + (insert "\t") + (soap-insert-describe-button (soap-bound-operation-operation bound-op)) + (when (or use (not (equal soap-action ""))) + (insert (make-string (- op-name-width (length op)) ?\s)) + (insert " (") + (insert soap-action) + (when use + (insert " " (symbol-name use))) + (insert ")")) + (insert "\n"))))) + +(defun soap-inspect-port (port) + "Insert information about PORT into the current buffer." + (insert "Port name: " (soap-element-name port) "\n" + "Service URL: " (soap-port-service-url port) "\n" + "Binding: ") + (soap-insert-describe-button (soap-port-binding port))) + +(defun soap-inspect-wsdl (wsdl) + "Insert information about WSDL into the current buffer." + (insert "WSDL Origin: " (soap-wsdl-origin wsdl) "\n") + (insert "Ports:") + (dolist (p (soap-wsdl-ports wsdl)) + (insert "\n--------------------\n") + ;; (soap-insert-describe-button p) + (soap-inspect-port p)) + (insert "\n--------------------\nNamespace alias table:\n") + (dolist (a (soap-wsdl-alias-table wsdl)) + (insert "\t" (car a) " => " (cdr a) "\n"))) + +(progn + ;; Install the soap-inspect methods for our types + + (put (aref (make-soap-basic-type) 0) 'soap-inspect + 'soap-inspect-basic-type) + + (put (aref (make-soap-sequence-type) 0) 'soap-inspect + 'soap-inspect-sequence-type) + + (put (aref (make-soap-array-type) 0) 'soap-inspect + 'soap-inspect-array-type) + + (put (aref (make-soap-message) 0) 'soap-inspect + 'soap-inspect-message) + (put (aref (make-soap-operation) 0) 'soap-inspect + 'soap-inspect-operation) + + (put (aref (make-soap-port-type) 0) 'soap-inspect + 'soap-inspect-port-type) + + (put (aref (make-soap-binding) 0) 'soap-inspect + 'soap-inspect-binding) + + (put (aref (make-soap-port) 0) 'soap-inspect + 'soap-inspect-port) + + (put (aref (make-soap-wsdl) 0) 'soap-inspect + 'soap-inspect-wsdl)) + +(provide 'soap-inspect) +;;; soap-inspect.el ends here ------------------------------------------------------------ revno: 103290 author: Leo committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 00:51:39 -0800 message: More dired-x cleanup. * lisp/dired-x.el (dired-mode-map, dired-extra-startup): Remove dired-copy-filename-as-kill since it's already in dired.el. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-16 08:39:19 +0000 +++ lisp/ChangeLog 2011-02-16 08:51:39 +0000 @@ -1,3 +1,8 @@ +2011-02-16 Leo + + * dired-x.el (dired-mode-map, dired-extra-startup): + Remove dired-copy-filename-as-kill since it's already in dired.el. + 2011-02-16 Glenn Morris * dired-x.el (dired-bind-jump, dired-bind-man, dired-bind-info): === modified file 'lisp/dired-x.el' --- lisp/dired-x.el 2011-02-16 08:32:30 +0000 +++ lisp/dired-x.el 2011-02-16 08:51:39 +0000 @@ -245,7 +245,6 @@ (define-key dired-mode-map "*(" 'dired-mark-sexp) (define-key dired-mode-map "*." 'dired-mark-extension) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) -(define-key dired-mode-map "w" 'dired-copy-filename-as-kill) (define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) (define-key dired-mode-map "Y" 'dired-do-relsymlink) @@ -308,8 +307,6 @@ \\[dired-do-find-marked-files]\t-- visit all marked files simultaneously \\[dired-omit-mode]\t-- toggle omitting of files \\[dired-mark-sexp]\t-- mark by Lisp expression - \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring; - \t you can feed it to other commands using \\[yank] To see the options you can set, use M-x customize-group RET dired-x RET. See also the functions: ------------------------------------------------------------ revno: 103289 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 00:46:13 -0800 message: Use emacsver.texi in dired-x.texi. * doc/misc/dired-x.texi: Use emacsver.texi to get Emacs version. * doc/misc/Makefile.in ($(infodir)/dired-x, dired-x.dvi, dired-x.pdf): Depend on emacsver.texi. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-02-16 08:39:19 +0000 +++ doc/misc/ChangeLog 2011-02-16 08:46:13 +0000 @@ -1,5 +1,9 @@ 2011-02-16 Glenn Morris + * dired-x.texi: Use emacsver.texi to get Emacs version. + * Makefile.in ($(infodir)/dired-x, dired-x.dvi, dired-x.pdf): + Depend on emacsver.texi. + * dired-x.texi: Drop meaningless version number. (Introduction): Remove old info. (Optional Installation Dired Jump): Autoload from dired-x. === modified file 'doc/misc/Makefile.in' --- doc/misc/Makefile.in 2011-02-06 00:25:41 +0000 +++ doc/misc/Makefile.in 2011-02-16 08:46:13 +0000 @@ -287,12 +287,12 @@ $(ENVADD) $(TEXI2PDF) $< dired-x : $(infodir)/dired-x -$(infodir)/dired-x: dired-x.texi +$(infodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi $(mkinfodir) cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $< -dired-x.dvi: ${srcdir}/dired-x.texi +dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $< -dired-x.pdf: ${srcdir}/dired-x.texi +dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) $< ebrowse : $(infodir)/ebrowse === modified file 'doc/misc/dired-x.texi' --- doc/misc/dired-x.texi 2011-02-16 08:39:19 +0000 +++ doc/misc/dired-x.texi 2011-02-16 08:46:13 +0000 @@ -10,6 +10,8 @@ @setfilename ../../info/dired-x @settitle Dired Extra User's Manual +@include emacsver.texi + @iftex @finalout @end iftex @@ -17,7 +19,8 @@ @comment %**end of header (This is for running Texinfo on a region.) @copying -Copyright @copyright{} 1994-1995, 1999, 2001-2011 Free Software Foundation, Inc. +Copyright @copyright{} 1994-1995, 1999, 2001-2011 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -79,7 +82,7 @@ Based on @file{dired.texi} by Sebastian Kremer @item -For @file{dired-x.el} as distributed with GNU Emacs 23. +For @file{dired-x.el} as distributed with GNU Emacs @value{EMACSVER}. @end itemize ------------------------------------------------------------ revno: 103288 [merge] committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 00:39:19 -0800 message: Merge from emacs-23; up to r100473. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-02-16 08:32:30 +0000 +++ doc/misc/ChangeLog 2011-02-16 08:39:19 +0000 @@ -1,5 +1,11 @@ 2011-02-16 Glenn Morris + * dired-x.texi: Drop meaningless version number. + (Introduction): Remove old info. + (Optional Installation Dired Jump): Autoload from dired-x. + Remove incorrect info about loaddefs.el. + (Bugs): Just refer to M-x report-emacs-bug. + * dired-x.texi (Multiple Dired Directories): Update for rename of default-directory-alist. (Miscellaneous Commands): No longer mention very old VM version 4. === modified file 'doc/misc/dired-x.texi' --- doc/misc/dired-x.texi 2011-02-16 08:32:30 +0000 +++ doc/misc/dired-x.texi 2011-02-16 08:39:19 +0000 @@ -7,10 +7,9 @@ @c [Dodd's address no longer valid.] @comment %**start of header (This is for running Texinfo on a region.) -@c FOR GNU EMACS USE ../info/dired-x BELOW @setfilename ../../info/dired-x -@c dired-x.el REVISION NUMBER -@settitle Dired Extra Version 2 User's Manual +@settitle Dired Extra User's Manual + @iftex @finalout @end iftex @@ -47,8 +46,7 @@ @titlepage @sp 6 -@c dired-x.el REVISION NUMBER -@center @titlefont{Dired Extra Version 2} +@center @titlefont{Dired Extra} @sp 2 @center @titlefont{For The GNU Emacs} @sp 1 @@ -70,10 +68,9 @@ @node Top @top Dired Extra -@comment node-name, next, previous, up @noindent -This documents the ``extra'' features for Dired Mode for GNU Emacs that are +This documents the ``extra'' features for GNU Emacs's Dired Mode that are provided by the file @file{dired-x.el}. @itemize @bullet @@ -81,20 +78,8 @@ @item Based on @file{dired.texi} by Sebastian Kremer -@c dired-x.el REVISION NUMBER @item -For @file{dired-x.el} revision 2 - -@c @item -@c Revision of this manual: 2.53 (2001/02/25 14:05:46) - -@c @item -@c Bugs to Lawrence R. Dodd . @emph{Please} type -@c @kbd{M-x dired-x-submit-report} to submit a bug report (@pxref{Bugs}). - -@c @item -@c You can obtain a copy of this package via anonymous ftp in -@c @t{/roebling.poly.edu:/pub/packages/dired-x.tar.gz} +For @file{dired-x.el} as distributed with GNU Emacs 23. @end itemize @@ -124,19 +109,11 @@ @end ifnottex @node Introduction, Installation, Top, Top -@comment node-name, next, previous, up @chapter Introduction -This documents the @emph{extra} features for Dired Mode for GNU Emacs. It -is derived from version 1.191 of Sebastian Kremer's @file{dired-x.el}. - -In adopting this @file{dired-x.el} to GNU Emacs v19 some material that has -been incorporated into @file{dired.el} and @file{dired-aux.el} of the GNU Emacs -19 distribution has been removed and some material was modified for agreement -with the functions in @file{dired.el} and @file{dired-aux.el}. For example, -the code using @code{gmhist} history functions was replaced with code using -the mini-buffer history now built into GNU Emacs. Finally, a few other -features have been added and a few more functions have been bound to keys. +This documents some @emph{extra} features for GNU Emacs's Dired Mode +that are provided by @file{dired-x.el} (derived from Sebastian Kremer's +original @file{dired-x.el}). @ifnottex @menu @@ -146,7 +123,6 @@ @end ifnottex @node Features, Technical Details, , Introduction -@comment node-name, next, previous, up @section Features @cindex Features @@ -194,7 +170,6 @@ Point}). @node Technical Details, , Features, Introduction -@comment node-name, next, previous, up @section Technical Details @cindex Redefined functions @cindex @file{dired-aux.el} @@ -222,7 +197,6 @@ @end itemize @node Installation, Omitting Files in Dired, Introduction, Top -@comment node-name, next, previous, up @chapter Installation @noindent @@ -231,8 +205,8 @@ file and (optionally) set some variables. @noindent -In your @file{.emacs} file in your home directory, or in the system-wide -initialization file @file{default.el} in the @file{site-lisp} directory, put +In your @file{~/.emacs} file, or in the system-wide initialization file +@file{default.el} in the @file{site-lisp} directory, put @example (add-hook 'dired-load-hook @@ -261,48 +235,27 @@ @end ifnottex @node Optional Installation Dired Jump, Optional Installation File At Point, , Installation -@comment node-name, next, previous, up @section Optional Installation Dired Jump @cindex Autoloading @code{dired-jump} and @code{dired-jump-other-window} In order to have @code{dired-jump} and @code{dired-jump-other-window} (@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and -@code{dired-x} have been properly loaded the user should set-up an autoload +@code{dired-x} have been properly loaded you should set-up an autoload for these functions. In your @file{.emacs} file put @example -;; Autoload `dired-jump' and `dired-jump-other-window'. -;; We autoload from FILE dired.el. This will then load dired-x.el -;; and hence define `dired-jump' and `dired-jump-other-window'. +(autoload 'dired-jump "dired-x" + "Jump to Dired buffer corresponding to current buffer." t) + +(autoload 'dired-jump-other-window "dired-x" + "Like \\[dired-jump] (dired-jump) but in other window." t) + (define-key global-map "\C-x\C-j" 'dired-jump) (define-key global-map "\C-x4\C-j" 'dired-jump-other-window) - -(autoload (quote dired-jump) "dired" "\ -Jump to Dired buffer corresponding to current buffer. -If in a file, Dired the current directory and move to file's line. -If in Dired already, pop up a level and goto old directory's line. -In case the proper Dired file line cannot be found, refresh the Dired -buffer and try again." t nil) - -(autoload (quote dired-jump-other-window) "dired" "\ -Like \\[dired-jump] (dired-jump) but in other window." t nil) -@end example - -Note that in recent releases of GNU Emacs 19 (i.e., 19.25 or later) the file -@file{../lisp/loaddefs.el} of the Emacs distribution already contains the -proper auto-loading for @code{dired-jump} so you need only put - -@example -(define-key global-map "\C-x\C-j" 'dired-jump) -@end example - -@noindent -in your @file{.emacs} file in order to have @kbd{C-x C-j} work -before @code{dired} is loaded. +@end example @node Optional Installation File At Point, , Optional Installation Dired Jump, Installation -@comment node-name, next, previous, up @section Optional Installation File At Point @cindex Binding @code{dired-x-find-file} @@ -335,7 +288,6 @@ @end example @node Omitting Files in Dired, Local Variables, Installation, Top -@comment node-name, next, previous, up @chapter Omitting Files in Dired @cindex Omitting Files in Dired @@ -392,8 +344,6 @@ @end ifnottex @node Omitting Variables, Omitting Examples, , Omitting Files in Dired -@comment node-name, next, previous, up - @section Omitting Variables @cindex Customizing file omitting @@ -501,7 +451,6 @@ @end table @node Omitting Examples, Omitting Technical, Omitting Variables, Omitting Files in Dired -@comment node-name, next, previous, up @section Examples of Omitting Various File Types @itemize @bullet @@ -555,7 +504,6 @@ @end itemize @node Omitting Technical, , Omitting Examples, Omitting Files in Dired -@comment node-name, next, previous, up @section Some Technical Details of Omitting Loading @file{dired-x.el} will install Dired Omit by putting @@ -563,8 +511,8 @@ call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup} in your @code{dired-mode-hook}. +@c FIXME does the standard dir-locals mechanism obsolete this? @node Local Variables, Shell Command Guessing, Omitting Files in Dired, Top -@comment node-name, next, previous, up @chapter Local Variables for Dired Directories @cindex Local Variables for Dired Directories @@ -633,7 +581,6 @@ @end table @node Shell Command Guessing, Virtual Dired, Local Variables, Top -@comment node-name, next, previous, up @chapter Shell Command Guessing @cindex Guessing shell commands for files. @@ -740,7 +687,6 @@ @end table @node Virtual Dired, Advanced Mark Commands, Shell Command Guessing, Top -@comment node-name, next, previous, up @chapter Virtual Dired @cindex Virtual Dired @@ -782,7 +728,6 @@ local-variable files. @node Advanced Mark Commands, Multiple Dired Directories, Virtual Dired, Top -@comment node-name, next, previous, up @chapter Advanced Mark Commands @table @kbd @@ -829,8 +774,6 @@ @end ifnottex @node Advanced Cleaning Functions, Advanced Cleaning Variables, , Advanced Mark Commands -@comment node-name, next, previous, up - @section Advanced Cleaning Functions @table @code @@ -862,8 +805,6 @@ @end table @node Advanced Cleaning Variables, Special Marking Function, Advanced Cleaning Functions, Advanced Mark Commands -@comment node-name, next, previous, up - @section Advanced Cleaning Variables @noindent Variables used by the above cleaning commands (and in the default value for @@ -903,8 +844,6 @@ @end table @node Special Marking Function, , Advanced Cleaning Variables, Advanced Mark Commands -@comment node-name, next, previous, up - @section Special Marking Function @table @kbd @@ -961,7 +900,6 @@ @end table @node Multiple Dired Directories, Find File At Point, Advanced Mark Commands, Top -@comment node-name, next, previous, up @chapter Multiple Dired Directories and Non-Dired Commands @cindex Multiple Dired directories @@ -994,8 +932,6 @@ @end table @node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top -@comment node-name, next, previous, up - @section Find File At Point @cindex Visiting a file mentioned in a buffer @cindex Finding a file at point @@ -1072,7 +1008,6 @@ @end table @node Miscellaneous Commands, Bugs, Find File At Point, Top -@comment node-name, next, previous, up @chapter Miscellaneous Commands Miscellaneous features not fitting anywhere else: @@ -1209,50 +1144,30 @@ @end table @node Bugs, GNU Free Documentation License, Miscellaneous Commands, Top -@comment node-name, next, previous, up @chapter Bugs @cindex Bugs -@findex dired-x-submit-report - -@noindent -If you encounter a bug in this package, wish to suggest an -enhancement, or want to make a smart remark, then type - -@example -@kbd{M-x dired-x-submit-report} -@end example - -@noindent -to set up an outgoing mail buffer, with the proper address to the -@file{dired-x.el} maintainer automatically inserted in the @samp{To:@:} field. -This command also inserts information that the Dired X maintainer can use to -recreate your exact setup, making it easier to verify your bug or social -maladjustment. - -Lawrence R. Dodd -@c + +@noindent +If you encounter a bug in this package, or wish to suggest an +enhancement, then please use @kbd{M-x report-emacs-bug} to report it. @node GNU Free Documentation License, Concept Index, Bugs, Top @appendix GNU Free Documentation License @include doclicense.texi @node Concept Index, Command Index, GNU Free Documentation License, Top -@comment node-name, next, previous, up @unnumbered Concept Index @printindex cp @node Command Index, Key Index, Concept Index, Top -@comment node-name, next, previous, up @unnumbered Function Index @printindex fn @node Key Index, Variable Index, Command Index, Top -@comment node-name, next, previous, up @unnumbered Key Index @printindex ky @node Variable Index, , Key Index, Top -@comment node-name, next, previous, up @unnumbered Variable Index @printindex vr === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-16 00:33:44 +0000 +++ src/ChangeLog 2011-02-16 08:39:19 +0000 @@ -1,3 +1,9 @@ +2011-02-16 Eli Zaretskii + + * xdisp.c (redisplay_internal): Resynchronize `w' if the selected + window is changed inside calls to do_pending_window_change. + (Bug#8020) + 2011-02-16 Paul Eggert Remove no-longer needed getloadavg symbols. === modified file 'src/xdisp.c' --- src/xdisp.c 2011-02-14 15:39:19 +0000 +++ src/xdisp.c 2011-02-16 08:39:19 +0000 @@ -11419,6 +11419,7 @@ redisplay_internal (int preserve_echo_area) { struct window *w = XWINDOW (selected_window); + struct window *sw; struct frame *f; int pause; int must_finish = 0; @@ -11479,6 +11480,9 @@ } retry: + /* Remember the currently selected window. */ + sw = w; + if (!EQ (old_frame, selected_frame) && FRAME_LIVE_P (XFRAME (old_frame))) /* When running redisplay, we play a bit fast-and-loose and allow e.g. @@ -11546,6 +11550,14 @@ /* Notice any pending interrupt request to change frame size. */ do_pending_window_change (1); + /* do_pending_window_change could change the selected_window due to + frame resizing which makes the selected window too small. */ + if (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw) + { + sw = w; + reconsider_clip_changes (w, current_buffer); + } + /* Clear frames marked as garbaged. */ if (frame_garbaged) clear_garbaged_frames (); @@ -11815,6 +11827,10 @@ if (!must_finish) { do_pending_window_change (1); + /* If selected_window changed, redisplay again. */ + if (WINDOWP (selected_window) + && (w = XWINDOW (selected_window)) != sw) + goto retry; /* We used to always goto end_of_redisplay here, but this isn't enough if we have a blinking cursor. */ @@ -12109,8 +12125,9 @@ do_pending_window_change (1); /* If we just did a pending size change, or have additional - visible frames, redisplay again. */ - if (windows_or_buffers_changed && !pause) + visible frames, or selected_window changed, redisplay again. */ + if ((windows_or_buffers_changed && !pause) + || (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw)) goto retry; /* Clear the face and image caches. ------------------------------------------------------------ revno: 103287 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-02-16 00:32:30 -0800 message: More dired-x cleanup. * lisp/dired-x.el (dired-bind-jump, dired-bind-man, dired-bind-info): Doc fixes. Add :set property, replacing top-level calls. (dired-vm-read-only-folders, dired-vm): Doc fix (drop v. old VM 4). (dired-guess-shell-gnutar): Test tar version rather than system-type. (dired-extra-startup, dired-man, dired-info): Doc fixes. (dired-clean-up-after-deletion): Use when and dolist. (dired-jump): Use unless and when. (dired-virtual): Use line-end-position. (dired-default-directory-alist): Rename from default-directory-alist. (dired-default-directory): Update for above name change. (dired-vm): Drop VM < 5 and simplify. (dired-buffer-more-recently-used-p): Rewrite. (dired-filename-at-point): Use when and or. (dired-x-read-filename-at-point): Rename from read-filename-at-point. Update callers. * doc/misc/dired-x.texi (Multiple Dired Directories): Update for rename of default-directory-alist. (Miscellaneous Commands): No longer mention very old VM version 4. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-02-15 11:24:37 +0000 +++ doc/misc/ChangeLog 2011-02-16 08:32:30 +0000 @@ -1,3 +1,9 @@ +2011-02-16 Glenn Morris + + * dired-x.texi (Multiple Dired Directories): Update for rename of + default-directory-alist. + (Miscellaneous Commands): No longer mention very old VM version 4. + 2011-02-15 Paul Eggert Merge from gnulib. @@ -5,7 +11,8 @@ 2011-02-14 Teodor Zlatanov - * auth.texi (Help for users): Login collection is "Login" and not "login". + * auth.texi (Help for users): + Login collection is "Login" and not "login". 2011-02-13 Michael Albinus === modified file 'doc/misc/dired-x.texi' --- doc/misc/dired-x.texi 2011-02-13 02:21:30 +0000 +++ doc/misc/dired-x.texi 2011-02-16 08:32:30 +0000 @@ -978,8 +978,8 @@ directory in special major modes: @table @code -@item default-directory-alist -@vindex default-directory-alist +@item dired-default-directory-alist +@vindex dired-default-directory-alist Default: @code{((dired-mode . (dired-current-directory)))} Alist of major modes and their notion of @code{default-directory}, as a @@ -990,7 +990,7 @@ @findex dired-default-directory Use this function like you would use the variable @code{default-directory}, except that @code{dired-default-directory} -also consults the variable @code{default-directory-alist}. +also consults the variable @code{dired-default-directory-alist}. @end table @node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top @@ -1141,13 +1141,12 @@ @vindex dired-vm-read-only-folders If you give this command a prefix argument, it will visit the folder -read-only. This only works in VM 5, not VM 4. +read-only. If the variable @code{dired-vm-read-only-folders} is @code{t}, -@code{dired-vm} will -visit all folders read-only. If it is neither @code{nil} nor @code{t}, e.g., -the symbol @code{if-file-read-only}, only files not writable by you are -visited read-only. This is the recommended value if you run VM 5. +@code{dired-vm} will visit all folders read-only. If it is neither +@code{nil} nor @code{t}, e.g., the symbol @code{if-file-read-only}, only +files not writable by you are visited read-only. @vindex dired-bind-vm If the variable @code{dired-bind-vm} is @code{t}, @code{dired-vm} will be bound === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-15 05:09:54 +0000 +++ lisp/ChangeLog 2011-02-16 08:32:30 +0000 @@ -1,3 +1,21 @@ +2011-02-16 Glenn Morris + + * dired-x.el (dired-bind-jump, dired-bind-man, dired-bind-info): + Doc fixes. Add :set property, replacing top-level calls. + (dired-vm-read-only-folders, dired-vm): Doc fix (drop v. old VM 4). + (dired-guess-shell-gnutar): Test tar version rather than system-type. + (dired-extra-startup, dired-man, dired-info): Doc fixes. + (dired-clean-up-after-deletion): Use when and dolist. + (dired-jump): Use unless and when. + (dired-virtual): Use line-end-position. + (dired-default-directory-alist): Rename from default-directory-alist. + (dired-default-directory): Update for above name change. + (dired-vm): Drop VM < 5 and simplify. + (dired-buffer-more-recently-used-p): Rewrite. + (dired-filename-at-point): Use when and or. + (dired-x-read-filename-at-point): Rename from read-filename-at-point. + Update callers. + 2011-02-15 Glenn Morris * dired-x.el: Use easymenu for menu items. Fix item capitalization. === modified file 'lisp/dired-x.el' --- lisp/dired-x.el 2011-02-15 05:09:54 +0000 +++ lisp/dired-x.el 2011-02-16 08:32:30 +0000 @@ -32,7 +32,7 @@ ;; ;; (add-hook 'dired-load-hook ;; (lambda () -;; (require 'dired-x) +;; (load "dired-x") ;; ;; Set global variables here. For example: ;; ;; (setq dired-guess-shell-gnutar "gtar") ;; )) @@ -79,7 +79,6 @@ (defcustom dired-bind-vm nil "Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'. - RMAIL files in the old Babyl format (used before before Emacs 23.1) contain \"-*- rmail -*-\" at the top, so `dired-find-file' will run `rmail' on these files. New RMAIL files use the standard @@ -88,26 +87,49 @@ :group 'dired-keys) (defcustom dired-bind-jump t - "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not." + "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not. +Setting this variable directly after dired-x is loaded has no effect - +use \\[customize]." :type 'boolean + :set (lambda (sym val) + (if (set sym val) + (progn + (define-key global-map "\C-x\C-j" 'dired-jump) + (define-key global-map "\C-x4\C-j" 'dired-jump-other-window)) + (if (eq 'dired-jump (lookup-key global-map "\C-x\C-j")) + (define-key global-map "\C-x\C-j" nil)) + (if (eq 'dired-jump-other-window (lookup-key global-map "\C-x4\C-j")) + (define-key global-map "\C-x4\C-j" nil)))) :group 'dired-keys) (defcustom dired-bind-man t - "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not." + "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not. +Setting this variable directly after dired-x is loaded has no effect - +use \\[customize]." :type 'boolean + :set (lambda (sym val) + (if (set sym val) + (define-key dired-mode-map "N" 'dired-man) + (if (eq 'dired-man (lookup-key dired-mode-map "N")) + (define-key dired-mode-map "N" nil)))) :group 'dired-keys) (defcustom dired-bind-info t - "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not." + "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not. +Setting this variable directly after dired-x is loaded has no effect - +use \\[customize]." :type 'boolean + :set (lambda (sym val) + (if (set sym val) + (define-key dired-mode-map "I" 'dired-info) + (if (eq 'dired-info (lookup-key dired-mode-map "I")) + (define-key dired-mode-map "I" nil)))) :group 'dired-keys) (defcustom dired-vm-read-only-folders nil "If non-nil, \\[dired-vm] will visit all folders read-only. If neither nil nor t, e.g. the symbol `if-file-read-only', only -files not writable by you are visited read-only. - -Read-only folders only work in VM 5, not in VM 4." +files not writable by you are visited read-only." :type '(choice (const :tag "off" nil) (const :tag "on" t) (other :tag "non-writable only" if-file-read-only)) @@ -181,13 +203,20 @@ :type 'boolean :group 'dired-x) -(defcustom dired-guess-shell-gnutar (when (or (eq system-type 'gnu) - (eq system-type 'gnu/linux)) - "tar") +(defcustom dired-guess-shell-gnutar + (catch 'found + (dolist (exe '("tar" "gtar")) + (if (with-temp-buffer + (ignore-errors (call-process exe nil t nil "--version")) + (and (re-search-backward "GNU tar" nil t) t)) + (throw 'found exe)))) "If non-nil, name of GNU tar executable. \(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for compressed or gzip'ed tar files. If you don't have GNU tar, set this to nil: a pipe using `zcat' or `gunzip -c' will be used." + ;; Changed from system-type test to testing --version output. + ;; Maybe test --help for -z instead? + :version "24.1" :type '(choice (const :tag "Not GNU tar" nil) (string :tag "Command name")) :group 'dired-x) @@ -223,12 +252,6 @@ (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp) (define-key dired-mode-map "V" 'dired-do-run-mail) -(if dired-bind-man - (define-key dired-mode-map "N" 'dired-man)) - -(if dired-bind-info - (define-key dired-mode-map "I" 'dired-info)) - ;;; MENU BINDINGS (require 'easymenu) @@ -270,11 +293,6 @@ files"] "Refresh")) -;;; GLOBAL BINDING. -(when dired-bind-jump - (define-key global-map "\C-x\C-j" 'dired-jump) - (define-key global-map "\C-x4\C-j" 'dired-jump-other-window)) - ;; Install into appropriate hooks. @@ -293,28 +311,8 @@ \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring; \t you can feed it to other commands using \\[yank] -For more features, see variables - - `dired-bind-vm' - `dired-bind-jump' - `dired-bind-info' - `dired-bind-man' - `dired-vm-read-only-folders' - `dired-omit-mode' - `dired-omit-files' - `dired-omit-extensions' - `dired-omit-size-limit' - `dired-find-subdir' - `dired-enable-local-variables' - `dired-local-variables-file' - `dired-guess-shell-gnutar' - `dired-guess-shell-gzip-quiet' - `dired-guess-shell-znew-switches' - `dired-guess-shell-alist-user' - `dired-clean-up-buffers-too' - -See also functions - +To see the options you can set, use M-x customize-group RET dired-x RET. +See also the functions: `dired-flag-extension' `dired-virtual' `dired-jump' @@ -339,26 +337,22 @@ (save-excursion (and (cdr dired-subdir-alist) (dired-goto-subdir fn) (dired-kill-subdir))) - ;; Offer to kill buffer of deleted file FN. - (if dired-clean-up-buffers-too - (progn - (let ((buf (get-file-buffer fn))) - (and buf - (funcall (function y-or-n-p) - (format "Kill buffer of %s, too? " - (file-name-nondirectory fn))) - (save-excursion ; you never know where kill-buffer leaves you - (kill-buffer buf)))) - (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))) - (buf nil)) - (and buf-list - (y-or-n-p (format "Kill dired buffer%s of %s, too? " - (dired-plural-s (length buf-list)) - (file-name-nondirectory fn))) - (while buf-list - (save-excursion (kill-buffer (car buf-list))) - (setq buf-list (cdr buf-list))))))) + (when dired-clean-up-buffers-too + (let ((buf (get-file-buffer fn))) + (and buf + (funcall (function y-or-n-p) + (format "Kill buffer of %s, too? " + (file-name-nondirectory fn))) + (save-excursion ; you never know where kill-buffer leaves you + (kill-buffer buf)))) + (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) + (and buf-list + (y-or-n-p (format "Kill dired buffer%s of %s, too? " + (dired-plural-s (length buf-list)) + (file-name-nondirectory fn))) + (dolist (buf buf-list) + (save-excursion (kill-buffer buf)))))) ;; Anything else? ) @@ -460,11 +454,10 @@ (progn (setq dir (dired-current-directory)) (dired-up-directory other-window) - (or (dired-goto-file dir) + (unless (dired-goto-file dir) ;; refresh and try again - (progn - (dired-insert-subdir (file-name-directory dir)) - (dired-goto-file dir)))) + (dired-insert-subdir (file-name-directory dir)) + (dired-goto-file dir))) (if other-window (dired-other-window dir) (dired dir)) @@ -475,10 +468,9 @@ (dired-insert-subdir (file-name-directory file)) (dired-goto-file file)) ;; Toggle omitting, if it is on, and try again. - (if dired-omit-mode - (progn - (dired-omit-mode) - (dired-goto-file file)))))))) + (when dired-omit-mode + (dired-omit-mode) + (dired-goto-file file))))))) (defun dired-jump-other-window (&optional file-name) "Like \\[dired-jump] (`dired-jump') but in other window." @@ -695,7 +687,7 @@ (forward-line 1) (and (looking-at "^ wildcard ") (buffer-substring (match-end 0) - (progn (end-of-line) (point))))))) + (line-end-position)))))) (if wildcard (setq dirname (expand-file-name wildcard default-directory)))) ;; If raw ls listing (not a saved old dired buffer), give it a @@ -777,9 +769,12 @@ ;; mechanism is provided for special handling of the working directory in ;; special major modes. +(define-obsolete-variable-alias 'default-directory-alist + 'dired-default-directory-alist "24.1") + ;; It's easier to add to this alist than redefine function ;; default-directory while keeping the old information. -(defconst default-directory-alist +(defconst dired-default-directory-alist '((dired-mode . (if (fboundp 'dired-current-directory) (dired-current-directory) default-directory))) @@ -789,8 +784,8 @@ (defun dired-default-directory () "Usage like variable `default-directory'. -Knows about the special cases in variable `default-directory-alist'." - (or (eval (cdr (assq major-mode default-directory-alist))) +Knows about the special cases in variable `dired-default-directory-alist'." + (or (eval (cdr (assq major-mode dired-default-directory-alist))) default-directory)) (defun dired-smart-shell-command (command &optional output-buffer error-buffer) @@ -1369,8 +1364,9 @@ (declare-function Man-getpage-in-background "man" (topic)) (defun dired-man () - "Run man on this file. Display old buffer if buffer name matches filename. -Uses `man.el' of \\[manual-entry] fame." + "Run `man' on this file." +;; Used also to say: "Display old buffer if buffer name matches filename." +;; but I have no idea what that means. (interactive) (require 'man) (let* ((file (dired-get-filename)) @@ -1382,7 +1378,7 @@ ;; Run Info on files. (defun dired-info () - "Run info on this file." + "Run `info' on this file." (interactive) (info (dired-get-filename))) @@ -1393,17 +1389,16 @@ (defun dired-vm (&optional read-only) "Run VM on this file. -With prefix arg, visit folder read-only (this requires at least VM 5). -See also variable `dired-vm-read-only-folders'." +With optional prefix argument, visits the folder read-only. +Otherwise obeys the value of `dired-vm-read-only-folders'." (interactive "P") (let ((dir (dired-current-directory)) (fil (dired-get-filename))) - ;; take care to supply 2nd arg only if requested - may still run VM 4! - (cond (read-only (vm-visit-folder fil t)) - ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t)) - ((null dired-vm-read-only-folders) (vm-visit-folder fil)) - (t (vm-visit-folder fil (not (file-writable-p fil))))) - ;; so that pressing `v' inside VM does prompt within current directory: + (vm-visit-folder fil (or read-only + (eq t dired-vm-read-only-folders) + (and dired-vm-read-only-folders + (not (file-writable-p fil))))) + ;; So that pressing `v' inside VM does prompt within current directory: (set (make-local-variable 'vm-folder-directory) dir))) (defun dired-rmail () @@ -1450,16 +1445,11 @@ ;; This should be a builtin (defun dired-buffer-more-recently-used-p (buffer1 buffer2) - "Return t if BUFFER1 is more recently used than BUFFER2." - (if (equal buffer1 buffer2) - nil - (let ((more-recent nil) - (list (buffer-list))) - (while (and list - (not (setq more-recent (equal buffer1 (car list)))) - (not (equal buffer2 (car list)))) - (setq list (cdr list))) - more-recent))) + "Return t if BUFFER1 is more recently used than BUFFER2. +Considers buffers closer to the car of `buffer-list' to be more recent." + (and (not (equal buffer1 buffer2)) + (memq buffer1 (buffer-list)) + (not (memq buffer1 (memq buffer2 (buffer-list)))))) ;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 ;; (defun dired-buffers-for-dir-exact (dir) @@ -1559,7 +1549,7 @@ (forward-char mode-len) (setq nlink (read (current-buffer))) ;; Karsten Wenger fixed uid. - (setq uid (buffer-substring (+ (point) 1) + (setq uid (buffer-substring (1+ (point)) (progn (forward-word 1) (point)))) (re-search-forward directory-listing-before-filename-regexp) (goto-char (match-beginning 1)) @@ -1649,7 +1639,7 @@ \(e.g., \\[universal-argument]\), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename." - (interactive (list (read-filename-at-point "Find file: "))) + (interactive (list (dired-x-read-filename-at-point "Find file: "))) (find-file (expand-file-name filename))) (defun dired-x-find-file-other-window (filename) @@ -1661,7 +1651,7 @@ a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. Useful for editing file mentioned in buffer you are viewing, or to test if that file exists. Use minibuffer after snatching filename." - (interactive (list (read-filename-at-point "Find file: "))) + (interactive (list (dired-x-read-filename-at-point "Find file: "))) (find-file-other-window (expand-file-name filename))) ;;; Internal functions. @@ -1677,13 +1667,10 @@ (save-excursion ;; First see if just past a filename. - (if (not (eobp)) - (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens - (progn - (skip-chars-backward " \n\t\r({[]})") - (if (not (bobp)) - (backward-char 1))))) - + (or (eobp) + (when (looking-at "[] \t\n[{}()]") ; whitespace or some parens + (skip-chars-backward " \n\t\r({[]})") + (or (bobp) (backward-char 1)))) (if (string-match (concat "[" filename-chars "]") (char-to-string (following-char))) (progn @@ -1706,7 +1693,7 @@ ;; Return string. (expand-file-name (concat prefix (buffer-substring start (point))))))) -(defun read-filename-at-point (prompt) +(defun dired-x-read-filename-at-point (prompt) "Return filename prompting with PROMPT with completion. If `current-prefix-arg' is non-nil, uses name at point as guess." (if current-prefix-arg @@ -1716,6 +1703,9 @@ guess nil (file-name-nondirectory guess))) (read-file-name prompt default-directory))) + +(define-obsolete-function-alias 'read-filename-at-point + 'dired-x-read-filename-at-point "24.1") ; is this even needed? ;;; BUG REPORTS ------------------------------------------------------------ revno: 103286 committer: Paul Eggert branch nick: trunk timestamp: Tue 2011-02-15 16:33:44 -0800 message: Import getloadavg module from gnulib. diff: === modified file '.bzrignore' --- .bzrignore 2011-02-13 18:35:05 +0000 +++ .bzrignore 2011-02-16 00:33:44 +0000 @@ -39,6 +39,7 @@ lib/arg-nonnull.h lib/c++defs.h lib/getopt.h +lib/stdlib.h lib/time.h lib/unistd.h lib/warn-on-use.h === modified file 'ChangeLog' --- ChangeLog 2011-02-16 00:19:57 +0000 +++ ChangeLog 2011-02-16 00:33:44 +0000 @@ -1,3 +1,24 @@ +2011-02-16 Paul Eggert + + Import getloadavg module from gnulib. + * .bzrignore: Add lib/stdlib.h. + * Makefile.in (GNULIB_MODULES): Add getloadavg. + * admin/notes/copyright: Remove src/getloadavg.c as a special case. + * configure.in (LIBS_SYSTEM): Omit -lkstat on sol2*; gnulib does this. + (AC_CONFIG_LIBOBJ_DIR, AC_FUNC_GETLOADAVG, GETLOADAVG_FILES): + Remove; gnulib does this now. + * lib/getloadavg.c: Rename from src/getloadavg.c, and sync + from gnulib. This adds support for several other systems, such + as Tru64 4.0D, QNX, AIX perfstat, etc. It also fixes a potential + buffer overrun on Linux hosts under very high load, and on hosts + that maintain a channel to the load average file it makes sure + the file descriptor is close-on-exec (on hosts that support this) + and is not stdin, stdout, or stderr. + * lib/stdlib.in.h, m4/getloadavg.m4, m4/stdlib_h.m4: New files, + from gnulib. + * aclocal.m4, configure, lib/Makefile.in, lib/gnulib.mk, m4/gl-comp.m4: + * src/config.in: Regenerate. + 2011-02-15 Paul Eggert Merge from gnulib. === modified file 'Makefile.in' --- Makefile.in 2011-02-03 19:29:35 +0000 +++ Makefile.in 2011-02-16 00:33:44 +0000 @@ -330,7 +330,7 @@ # Update modules from gnulib, for maintainers, who should have it in # $(gnulib_srcdir) (relative to $(srcdir) and should have build tools # as per $(gnulib_srcdir)/DEPENDENCIES. -GNULIB_MODULES = dtoastr getopt-gnu ignore-value mktime strftime +GNULIB_MODULES = dtoastr getloadavg getopt-gnu ignore-value mktime strftime GNULIB_TOOL_FLAGS = \ --import --no-changelog --no-vc-files --makefile-name=gnulib.mk sync-from-gnulib: $(gnulib_srcdir) === modified file 'aclocal.m4' --- aclocal.m4 2011-01-30 23:34:18 +0000 +++ aclocal.m4 2011-02-16 00:33:44 +0000 @@ -987,6 +987,7 @@ m4_include([m4/00gnulib.m4]) m4_include([m4/c-strtod.m4]) m4_include([m4/extensions.m4]) +m4_include([m4/getloadavg.m4]) m4_include([m4/getopt.m4]) m4_include([m4/gl-comp.m4]) m4_include([m4/gnulib-common.m4]) @@ -995,6 +996,7 @@ m4_include([m4/multiarch.m4]) m4_include([m4/stdbool.m4]) m4_include([m4/stddef_h.m4]) +m4_include([m4/stdlib_h.m4]) m4_include([m4/strftime.m4]) m4_include([m4/time_h.m4]) m4_include([m4/time_r.m4]) === modified file 'admin/CPP-DEFINES' --- admin/CPP-DEFINES 2011-01-15 23:16:57 +0000 +++ admin/CPP-DEFINES 2011-02-16 00:33:44 +0000 @@ -62,8 +62,6 @@ SYSTEM_TYPE ** Machine specific macros, decribed in detail in src/m/template.h -LOAD_AVE_CVT -LOAD_AVE_TYPE VIRT_ADDR_VARIES ** Misc macros @@ -111,7 +109,6 @@ EMACS_UINT FILE_SYSTEM_CASE FLOAT_CHECK_DOMAIN -FSCALE GC_LISP_OBJECT_ALIGNMENT GC_MARK_SECONDARY_STACK GC_MARK_STACK @@ -193,8 +190,6 @@ INTERNAL_TERMINAL IS_ANY_SEP IS_DIRECTORY_SEP -KERNEL_FILE -LDAV_SYMBOL LINKER LINUX_VERSION_CODE LISP_FLOAT_TYPE @@ -381,4 +376,3 @@ wait write xfree - === modified file 'admin/ChangeLog' --- admin/ChangeLog 2011-02-12 23:37:43 +0000 +++ admin/ChangeLog 2011-02-16 00:33:44 +0000 @@ -1,3 +1,9 @@ +2011-02-16 Paul Eggert + + Remove no-longer needed getloadavg symbols. + * CPP-DEFINES (LOAD_AVE_CVT, LOAD_AVE_TYPE, FSCALE, KERNEL_FILE): + (LDAV_SYMBOL): Remove. + 2011-02-12 Glenn Morris * bzrmerge.el (bzrmerge-resolve): Fix bzr revert call. === modified file 'admin/notes/copyright' --- admin/notes/copyright 2011-01-30 23:34:18 +0000 +++ admin/notes/copyright 2011-02-16 00:33:44 +0000 @@ -631,7 +631,6 @@ warn-on-use.h lib/*.[ch] lib/gnulib.mk - src/getloadavg.c src/gmalloc.c src/md5.c src/md5.h === modified file 'configure' --- configure 2011-02-08 21:42:56 +0000 +++ configure 2011-02-16 00:33:44 +0000 @@ -599,7 +599,6 @@ # include #endif" -ac_config_libobj_dir=src ac_header_list= gl_getopt_required=POSIX gl_getopt_required=POSIX @@ -611,6 +610,7 @@ am__EXEEXT_FALSE am__EXEEXT_TRUE LTLIBOBJS +LIBOBJS WINDOW_SUPPORT TOOLTIP_SUPPORT MOUSE_SUPPORT @@ -677,6 +677,8 @@ TIME_H_DEFINES_STRUCT_TIMESPEC NEXT_AS_FIRST_DIRECTIVE_TIME_H NEXT_TIME_H +NEXT_AS_FIRST_DIRECTIVE_STDLIB_H +NEXT_STDLIB_H NEXT_AS_FIRST_DIRECTIVE_STDDEF_H NEXT_STDDEF_H STDDEF_H @@ -813,12 +815,70 @@ GNULIB_DUP2 GNULIB_CLOSE GNULIB_CHOWN +GETLOADAVG_LIBS +REPLACE_UNSETENV +REPLACE_STRTOD +REPLACE_SETENV +REPLACE_REALPATH +REPLACE_REALLOC +REPLACE_PUTENV +REPLACE_MKSTEMP +REPLACE_MALLOC +REPLACE_CANONICALIZE_FILE_NAME +REPLACE_CALLOC +HAVE_DECL_UNSETENV +HAVE_UNLOCKPT +HAVE_SYS_LOADAVG_H +HAVE_STRUCT_RANDOM_DATA +HAVE_STRTOULL +HAVE_STRTOLL +HAVE_STRTOD +HAVE_DECL_SETENV +HAVE_SETENV +HAVE_RPMATCH +HAVE_REALPATH +HAVE_RANDOM_R +HAVE_RANDOM_H +HAVE_PTSNAME +HAVE_MKSTEMPS +HAVE_MKSTEMP +HAVE_MKOSTEMPS +HAVE_MKOSTEMP +HAVE_MKDTEMP +HAVE_GRANTPT +HAVE_GETSUBOPT +HAVE_DECL_GETLOADAVG +HAVE_CANONICALIZE_FILE_NAME +HAVE_ATOLL +HAVE__EXIT +GNULIB_UNSETENV +GNULIB_UNLOCKPT +GNULIB_SYSTEM_POSIX +GNULIB_STRTOULL +GNULIB_STRTOLL +GNULIB_STRTOD +GNULIB_SETENV +GNULIB_RPMATCH +GNULIB_REALPATH +GNULIB_REALLOC_POSIX +GNULIB_RANDOM_R +GNULIB_PUTENV +GNULIB_PTSNAME +GNULIB_MKSTEMPS +GNULIB_MKSTEMP +GNULIB_MKOSTEMPS +GNULIB_MKOSTEMP +GNULIB_MKDTEMP +GNULIB_MALLOC_POSIX +GNULIB_GRANTPT +GNULIB_GETSUBOPT +GNULIB_GETLOADAVG +GNULIB_CANONICALIZE_FILE_NAME +GNULIB_CALLOC_POSIX +GNULIB_ATOLL +GNULIB__EXIT GL_COND_LIBTOOL_FALSE GL_COND_LIBTOOL_TRUE -GETLOADAVG_LIBS -KMEM_GROUP -NEED_SETGID -LIBOBJS BLESSMAIL_TARGET LIBS_MAIL liblockfile @@ -1043,6 +1103,9 @@ LIBS CPPFLAGS CPP +CPPFLAGS +CPP +CPPFLAGS XMKMF' @@ -5821,6 +5884,7 @@ # Code from module dtoastr: # Code from module extensions: + # Code from module getloadavg: # Code from module getopt-gnu: # Code from module getopt-posix: # Code from module gettext-h: @@ -5831,6 +5895,7 @@ # Code from module multiarch: # Code from module stdbool: # Code from module stddef: + # Code from module stdlib: # Code from module strftime: # Code from module time: # Code from module time_r: @@ -6703,7 +6768,7 @@ hpux*) LIBS_SYSTEM="-l:libdld.sl" ;; - sol2*) LIBS_SYSTEM="-lsocket -lnsl -lkstat" ;; + sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;; ## Motif needs -lgen. unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; @@ -6719,8 +6784,6 @@ CPPFLAGS="$C_SWITCH_SYSTEM $C_SWITCH_MACHINE $CPPFLAGS" fi - - # Check whether --enable-largefile was given. if test "${enable_largefile+set}" = set; then : enableval=$enable_largefile; @@ -13020,500 +13083,6 @@ done -ac_have_func=no # yes means we've found a way to get the load average. - -# Make sure getloadavg.c is where it belongs, at configure-time. -test -f "$srcdir/$ac_config_libobj_dir/getloadavg.c" || - as_fn_error $? "$srcdir/$ac_config_libobj_dir/getloadavg.c is missing" "$LINENO" 5 - -ac_save_LIBS=$LIBS - -# Check for getloadavg, but be sure not to touch the cache variable. -(ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = xyes; then : - exit 0 -else - exit 1 -fi -) && ac_have_func=yes - -# On HPUX9, an unprivileged user can get load averages through this function. -for ac_func in pstat_getdynamic -do : - ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" -if test "x$ac_cv_func_pstat_getdynamic" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_PSTAT_GETDYNAMIC 1 -_ACEOF - -fi -done - - -# Solaris has libkstat which does not require root. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 -$as_echo_n "checking for kstat_open in -lkstat... " >&6; } -if ${ac_cv_lib_kstat_kstat_open+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkstat $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char kstat_open (); -int -main () -{ -return kstat_open (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_kstat_kstat_open=yes -else - ac_cv_lib_kstat_kstat_open=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 -$as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } -if test "x$ac_cv_lib_kstat_kstat_open" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBKSTAT 1 -_ACEOF - - LIBS="-lkstat $LIBS" - -fi - -test $ac_cv_lib_kstat_kstat_open = yes && ac_have_func=yes - -# Some systems with -lutil have (and need) -lkvm as well, some do not. -# On Solaris, -lkvm requires nlist from -lelf, so check that first -# to get the right answer into the cache. -# For kstat on solaris, we need libelf to force the definition of SVR4 below. -if test $ac_have_func = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 -$as_echo_n "checking for elf_begin in -lelf... " >&6; } -if ${ac_cv_lib_elf_elf_begin+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lelf $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char elf_begin (); -int -main () -{ -return elf_begin (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_elf_elf_begin=yes -else - ac_cv_lib_elf_elf_begin=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5 -$as_echo "$ac_cv_lib_elf_elf_begin" >&6; } -if test "x$ac_cv_lib_elf_elf_begin" = xyes; then : - LIBS="-lelf $LIBS" -fi - -fi -if test $ac_have_func = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5 -$as_echo_n "checking for kvm_open in -lkvm... " >&6; } -if ${ac_cv_lib_kvm_kvm_open+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkvm $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char kvm_open (); -int -main () -{ -return kvm_open (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_kvm_kvm_open=yes -else - ac_cv_lib_kvm_kvm_open=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_open" >&5 -$as_echo "$ac_cv_lib_kvm_kvm_open" >&6; } -if test "x$ac_cv_lib_kvm_kvm_open" = xyes; then : - LIBS="-lkvm $LIBS" -fi - - # Check for the 4.4BSD definition of getloadavg. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lutil" >&5 -$as_echo_n "checking for getloadavg in -lutil... " >&6; } -if ${ac_cv_lib_util_getloadavg+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lutil $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char getloadavg (); -int -main () -{ -return getloadavg (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_util_getloadavg=yes -else - ac_cv_lib_util_getloadavg=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 -$as_echo "$ac_cv_lib_util_getloadavg" >&6; } -if test "x$ac_cv_lib_util_getloadavg" = xyes; then : - LIBS="-lutil $LIBS" ac_have_func=yes ac_cv_func_getloadavg_setgid=yes -fi - -fi - -if test $ac_have_func = no; then - # There is a commonly available library for RS/6000 AIX. - # Since it is not a standard part of AIX, it might be installed locally. - ac_getloadavg_LIBS=$LIBS - LIBS="-L/usr/local/lib $LIBS" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lgetloadavg" >&5 -$as_echo_n "checking for getloadavg in -lgetloadavg... " >&6; } -if ${ac_cv_lib_getloadavg_getloadavg+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgetloadavg $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char getloadavg (); -int -main () -{ -return getloadavg (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_getloadavg_getloadavg=yes -else - ac_cv_lib_getloadavg_getloadavg=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 -$as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } -if test "x$ac_cv_lib_getloadavg_getloadavg" = xyes; then : - LIBS="-lgetloadavg $LIBS" -else - LIBS=$ac_getloadavg_LIBS -fi - -fi - -# Make sure it is really in the library, if we think we found it, -# otherwise set up the replacement function. -for ac_func in getloadavg -do : - ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETLOADAVG 1 -_ACEOF - -else - case " $LIBOBJS " in - *" getloadavg.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS getloadavg.$ac_objext" - ;; -esac - - -$as_echo "#define C_GETLOADAVG 1" >>confdefs.h - -# Figure out what our getloadavg.c needs. -ac_have_func=no -ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_dg_sys_info_h" = xyes; then : - ac_have_func=yes - -$as_echo "#define DGUX 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 -$as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } -if ${ac_cv_lib_dgc_dg_sys_info+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldgc $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dg_sys_info (); -int -main () -{ -return dg_sys_info (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dgc_dg_sys_info=yes -else - ac_cv_lib_dgc_dg_sys_info=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgc_dg_sys_info" >&5 -$as_echo "$ac_cv_lib_dgc_dg_sys_info" >&6; } -if test "x$ac_cv_lib_dgc_dg_sys_info" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBDGC 1 -_ACEOF - - LIBS="-ldgc $LIBS" - -fi - -fi - - - -ac_fn_c_check_header_mongrel "$LINENO" "locale.h" "ac_cv_header_locale_h" "$ac_includes_default" -if test "x$ac_cv_header_locale_h" = xyes; then : - -fi - - -for ac_func in setlocale -do : - ac_fn_c_check_func "$LINENO" "setlocale" "ac_cv_func_setlocale" -if test "x$ac_cv_func_setlocale" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SETLOCALE 1 -_ACEOF - -fi -done - - -# We cannot check for , because Solaris 2 does not use dwarf (it -# uses stabs), but it is still SVR4. We cannot check for because -# Irix 4.0.5F has the header but not the library. -if test $ac_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ - && test "$ac_cv_lib_kvm_kvm_open" = yes; then - ac_have_func=yes - -$as_echo "#define SVR4 1" >>confdefs.h - -fi - -if test $ac_have_func = no; then - ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_inq_stats_cpustats_h" = xyes; then : - ac_have_func=yes - -$as_echo "#define UMAX 1" >>confdefs.h - - -$as_echo "#define UMAX4_3 1" >>confdefs.h - -fi - - -fi - -if test $ac_have_func = no; then - ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_cpustats_h" = xyes; then : - ac_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h - -fi - - -fi - -if test $ac_have_func = no; then - for ac_header in mach/mach.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" -if test "x$ac_cv_header_mach_mach_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_MACH_MACH_H 1 -_ACEOF - -fi - -done - -fi - -for ac_header in nlist.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" -if test "x$ac_cv_header_nlist_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NLIST_H 1 -_ACEOF - ac_fn_c_check_member "$LINENO" "struct nlist" "n_un.n_name" "ac_cv_member_struct_nlist_n_un_n_name" "#include -" -if test "x$ac_cv_member_struct_nlist_n_un_n_name" = xyes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 -_ACEOF - - -$as_echo "#define NLIST_NAME_UNION 1" >>confdefs.h - -fi - - -fi - -done - -fi -done - - -# Some definitions of getloadavg require that the program be installed setgid. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getloadavg requires setgid" >&5 -$as_echo_n "checking whether getloadavg requires setgid... " >&6; } -if ${ac_cv_func_getloadavg_setgid+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include "$srcdir/$ac_config_libobj_dir/getloadavg.c" -#ifdef LDAV_PRIVILEGED -Yowza Am I SETGID yet -#endif -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "Yowza Am I SETGID yet" >/dev/null 2>&1; then : - ac_cv_func_getloadavg_setgid=yes -else - ac_cv_func_getloadavg_setgid=no -fi -rm -f conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getloadavg_setgid" >&5 -$as_echo "$ac_cv_func_getloadavg_setgid" >&6; } -if test $ac_cv_func_getloadavg_setgid = yes; then - NEED_SETGID=true - -$as_echo "#define GETLOADAVG_PRIVILEGED 1" >>confdefs.h - -else - NEED_SETGID=false -fi - -if test $ac_cv_func_getloadavg_setgid = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking group of /dev/kmem" >&5 -$as_echo_n "checking group of /dev/kmem... " >&6; } -if ${ac_cv_group_kmem+:} false; then : - $as_echo_n "(cached) " >&6 -else - # On Solaris, /dev/kmem is a symlink. Get info on the real file. - ac_ls_output=`ls -lgL /dev/kmem 2>/dev/null` - # If we got an error (system does not support symlinks), try without -L. - test -z "$ac_ls_output" && ac_ls_output=`ls -lg /dev/kmem` - ac_cv_group_kmem=`$as_echo "$ac_ls_output" \ - | sed -ne 's/[ ][ ]*/ /g; - s/^.[sSrwx-]* *[0-9]* *\([^0-9]*\) *.*/\1/; - / /s/.* //;p;'` - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_group_kmem" >&5 -$as_echo "$ac_cv_group_kmem" >&6; } - KMEM_GROUP=$ac_cv_group_kmem -fi -if test "x$ac_save_LIBS" = x; then - GETLOADAVG_LIBS=$LIBS -else - GETLOADAVG_LIBS=`$as_echo "$LIBS" | sed "s|$ac_save_LIBS||"` -fi -LIBS=$ac_save_LIBS - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5 $as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; } if ${ac_cv_sys_largefile_source+:} false; then : @@ -13676,6 +13245,69 @@ fi + GNULIB__EXIT=0; + GNULIB_ATOLL=0; + GNULIB_CALLOC_POSIX=0; + GNULIB_CANONICALIZE_FILE_NAME=0; + GNULIB_GETLOADAVG=0; + GNULIB_GETSUBOPT=0; + GNULIB_GRANTPT=0; + GNULIB_MALLOC_POSIX=0; + GNULIB_MKDTEMP=0; + GNULIB_MKOSTEMP=0; + GNULIB_MKOSTEMPS=0; + GNULIB_MKSTEMP=0; + GNULIB_MKSTEMPS=0; + GNULIB_PTSNAME=0; + GNULIB_PUTENV=0; + GNULIB_RANDOM_R=0; + GNULIB_REALLOC_POSIX=0; + GNULIB_REALPATH=0; + GNULIB_RPMATCH=0; + GNULIB_SETENV=0; + GNULIB_STRTOD=0; + GNULIB_STRTOLL=0; + GNULIB_STRTOULL=0; + GNULIB_SYSTEM_POSIX=0; + GNULIB_UNLOCKPT=0; + GNULIB_UNSETENV=0; + HAVE__EXIT=1; + HAVE_ATOLL=1; + HAVE_CANONICALIZE_FILE_NAME=1; + HAVE_DECL_GETLOADAVG=1; + HAVE_GETSUBOPT=1; + HAVE_GRANTPT=1; + HAVE_MKDTEMP=1; + HAVE_MKOSTEMP=1; + HAVE_MKOSTEMPS=1; + HAVE_MKSTEMP=1; + HAVE_MKSTEMPS=1; + HAVE_PTSNAME=1; + HAVE_RANDOM_H=1; + HAVE_RANDOM_R=1; + HAVE_REALPATH=1; + HAVE_RPMATCH=1; + HAVE_SETENV=1; + HAVE_DECL_SETENV=1; + HAVE_STRTOD=1; + HAVE_STRTOLL=1; + HAVE_STRTOULL=1; + HAVE_STRUCT_RANDOM_DATA=1; + HAVE_SYS_LOADAVG_H=0; + HAVE_UNLOCKPT=1; + HAVE_DECL_UNSETENV=1; + REPLACE_CALLOC=0; + REPLACE_CANONICALIZE_FILE_NAME=0; + REPLACE_MALLOC=0; + REPLACE_MKSTEMP=0; + REPLACE_PUTENV=0; + REPLACE_REALLOC=0; + REPLACE_REALPATH=0; + REPLACE_SETENV=0; + REPLACE_STRTOD=0; + REPLACE_UNSETENV=0; + + GNULIB_CHOWN=0; GNULIB_CLOSE=0; GNULIB_DUP2=0; @@ -14831,6 +14463,534 @@ # Code from module dtoastr: # Code from module extensions: + # Code from module getloadavg: + + +# Persuade glibc to declare getloadavg(). + + +# Make sure getloadavg.c is where it belongs, at configure-time. +test -f "$srcdir/$gl_source_base/getloadavg.c" || + as_fn_error $? "$srcdir/$gl_source_base/getloadavg.c is missing" "$LINENO" 5 + +gl_save_LIBS=$LIBS + +ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" +if test "x$ac_cv_func_getloadavg" = xyes; then : + +else + gl_have_func=no + + # Some systems with -lutil have (and need) -lkvm as well, some do not. + # On Solaris, -lkvm requires nlist from -lelf, so check that first + # to get the right answer into the cache. + # For kstat on solaris, we need to test for libelf and libkvm to force the + # definition of SVR4 below. + if test $gl_have_func = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 +$as_echo_n "checking for elf_begin in -lelf... " >&6; } +if ${ac_cv_lib_elf_elf_begin+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lelf $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char elf_begin (); +int +main () +{ +return elf_begin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_elf_elf_begin=yes +else + ac_cv_lib_elf_elf_begin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5 +$as_echo "$ac_cv_lib_elf_elf_begin" >&6; } +if test "x$ac_cv_lib_elf_elf_begin" = xyes; then : + LIBS="-lelf $LIBS" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5 +$as_echo_n "checking for kvm_open in -lkvm... " >&6; } +if ${ac_cv_lib_kvm_kvm_open+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lkvm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char kvm_open (); +int +main () +{ +return kvm_open (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_kvm_kvm_open=yes +else + ac_cv_lib_kvm_kvm_open=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_open" >&5 +$as_echo "$ac_cv_lib_kvm_kvm_open" >&6; } +if test "x$ac_cv_lib_kvm_kvm_open" = xyes; then : + LIBS="-lkvm $LIBS" +fi + + # Check for the 4.4BSD definition of getloadavg. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lutil" >&5 +$as_echo_n "checking for getloadavg in -lutil... " >&6; } +if ${ac_cv_lib_util_getloadavg+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lutil $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getloadavg (); +int +main () +{ +return getloadavg (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_util_getloadavg=yes +else + ac_cv_lib_util_getloadavg=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 +$as_echo "$ac_cv_lib_util_getloadavg" >&6; } +if test "x$ac_cv_lib_util_getloadavg" = xyes; then : + LIBS="-lutil $LIBS" gl_have_func=yes +fi + + fi + + if test $gl_have_func = no; then + # There is a commonly available library for RS/6000 AIX. + # Since it is not a standard part of AIX, it might be installed locally. + gl_getloadavg_LIBS=$LIBS + LIBS="-L/usr/local/lib $LIBS" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lgetloadavg" >&5 +$as_echo_n "checking for getloadavg in -lgetloadavg... " >&6; } +if ${ac_cv_lib_getloadavg_getloadavg+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgetloadavg $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getloadavg (); +int +main () +{ +return getloadavg (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_getloadavg_getloadavg=yes +else + ac_cv_lib_getloadavg_getloadavg=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 +$as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } +if test "x$ac_cv_lib_getloadavg_getloadavg" = xyes; then : + LIBS="-lgetloadavg $LIBS" gl_have_func=yes +else + LIBS=$gl_getloadavg_LIBS +fi + + fi + + # Set up the replacement function if necessary. + if test $gl_have_func = no; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext" + + +# Figure out what our getloadavg.c needs. + +# Solaris has libkstat which does not require root. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 +$as_echo_n "checking for kstat_open in -lkstat... " >&6; } +if ${ac_cv_lib_kstat_kstat_open+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lkstat $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char kstat_open (); +int +main () +{ +return kstat_open (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_kstat_kstat_open=yes +else + ac_cv_lib_kstat_kstat_open=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 +$as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } +if test "x$ac_cv_lib_kstat_kstat_open" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBKSTAT 1 +_ACEOF + + LIBS="-lkstat $LIBS" + +fi + +test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes + +# On HPUX9, an unprivileged user can get load averages this way. +if test $gl_have_func = no; then + for ac_func in pstat_getdynamic +do : + ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" +if test "x$ac_cv_func_pstat_getdynamic" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_PSTAT_GETDYNAMIC 1 +_ACEOF + gl_have_func=yes +fi +done + +fi + +# AIX has libperfstat which does not require root +if test $gl_have_func = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5 +$as_echo_n "checking for perfstat_cpu_total in -lperfstat... " >&6; } +if ${ac_cv_lib_perfstat_perfstat_cpu_total+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lperfstat $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char perfstat_cpu_total (); +int +main () +{ +return perfstat_cpu_total (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_perfstat_perfstat_cpu_total=yes +else + ac_cv_lib_perfstat_perfstat_cpu_total=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_perfstat_perfstat_cpu_total" >&5 +$as_echo "$ac_cv_lib_perfstat_perfstat_cpu_total" >&6; } +if test "x$ac_cv_lib_perfstat_perfstat_cpu_total" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBPERFSTAT 1 +_ACEOF + + LIBS="-lperfstat $LIBS" + +fi + + test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes +fi + +if test $gl_have_func = no; then + ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_dg_sys_info_h" = xyes; then : + gl_have_func=yes + +$as_echo "#define DGUX 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 +$as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } +if ${ac_cv_lib_dgc_dg_sys_info+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldgc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dg_sys_info (); +int +main () +{ +return dg_sys_info (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dgc_dg_sys_info=yes +else + ac_cv_lib_dgc_dg_sys_info=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgc_dg_sys_info" >&5 +$as_echo "$ac_cv_lib_dgc_dg_sys_info" >&6; } +if test "x$ac_cv_lib_dgc_dg_sys_info" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBDGC 1 +_ACEOF + + LIBS="-ldgc $LIBS" + +fi + +fi + + +fi + +# We cannot check for , because Solaris 2 does not use dwarf (it +# uses stabs), but it is still SVR4. We cannot check for because +# Irix 4.0.5F has the header but not the library. +if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ + && test "$ac_cv_lib_kvm_kvm_open" = yes; then + gl_have_func=yes + +$as_echo "#define SVR4 1" >>confdefs.h + +fi + +if test $gl_have_func = no; then + ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" +if test "x$ac_cv_header_inq_stats_cpustats_h" = xyes; then : + gl_have_func=yes + +$as_echo "#define UMAX 1" >>confdefs.h + + +$as_echo "#define UMAX4_3 1" >>confdefs.h + +fi + + +fi + +if test $gl_have_func = no; then + ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_cpustats_h" = xyes; then : + gl_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h + +fi + + +fi + +if test $gl_have_func = no; then + for ac_header in mach/mach.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" +if test "x$ac_cv_header_mach_mach_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_MACH_MACH_H 1 +_ACEOF + +fi + +done + +fi + +for ac_header in nlist.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" +if test "x$ac_cv_header_nlist_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_NLIST_H 1 +_ACEOF + ac_fn_c_check_member "$LINENO" "struct nlist" "n_un.n_name" "ac_cv_member_struct_nlist_n_un_n_name" "#include +" +if test "x$ac_cv_member_struct_nlist_n_un_n_name" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 +_ACEOF + + +fi + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +struct nlist x; + #ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME + x.n_un.n_name = ""; + #else + x.n_name = ""; + #endif + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +$as_echo "#define N_NAME_POINTER 1" >>confdefs.h + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi + +done + + fi +fi + + +if test "x$gl_save_LIBS" = x; then + GETLOADAVG_LIBS=$LIBS +else + GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` +fi +LIBS=$gl_save_LIBS + + +# Test whether the system declares getloadavg. Solaris has the function +# but declares it in , not . +for ac_header in sys/loadavg.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_loadavg_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_LOADAVG_H 1 +_ACEOF + +fi + +done + +if test $ac_cv_header_sys_loadavg_h = yes; then + HAVE_SYS_LOADAVG_H=1 +else + HAVE_SYS_LOADAVG_H=0 +fi +ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE_SYS_LOADAVG_H + # include + #endif + #include +" +if test "x$ac_cv_have_decl_getloadavg" = xyes; then : + +else + HAVE_DECL_GETLOADAVG=0 +fi + + + + + + GNULIB_GETLOADAVG=1 + + + # Code from module getopt-gnu: @@ -15262,6 +15422,65 @@ fi + # Code from module stdlib: + + + + + + + + + + + if test $gl_cv_have_include_next = yes; then + gl_cv_next_stdlib_h='<'stdlib.h'>' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 +$as_echo_n "checking absolute name of ... " >&6; } +if ${gl_cv_next_stdlib_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF + case "$host_os" in + aix*) gl_absname_cpp="$ac_cpp -C" ;; + *) gl_absname_cpp="$ac_cpp" ;; + esac + gl_cv_next_stdlib_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | + sed -n '\#/stdlib.h#{ + s#.*"\(.*/stdlib.h\)".*#\1# + s#^/[^/]#//&# + p + q + }'`'"' + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stdlib_h" >&5 +$as_echo "$gl_cv_next_stdlib_h" >&6; } + fi + NEXT_STDLIB_H=$gl_cv_next_stdlib_h + + if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next' + gl_next_as_first_directive='<'stdlib.h'>' + else + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' + gl_next_as_first_directive=$gl_cv_next_stdlib_h + fi + NEXT_AS_FIRST_DIRECTIVE_STDLIB_H=$gl_next_as_first_directive + + + + + + + # Code from module strftime: @@ -17079,7 +17298,6 @@ - cat >>confdefs.h <<_ACEOF #define EMACS_CONFIGURATION "${canonical}" _ACEOF === modified file 'configure.in' --- configure.in 2011-02-08 21:42:56 +0000 +++ configure.in 2011-02-16 00:33:44 +0000 @@ -984,7 +984,7 @@ hpux*) LIBS_SYSTEM="-l:libdld.sl" ;; - sol2*) LIBS_SYSTEM="-lsocket -lnsl -lkstat" ;; + sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;; ## Motif needs -lgen. unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; @@ -1000,9 +1000,6 @@ CPPFLAGS="$C_SWITCH_SYSTEM $C_SWITCH_MACHINE $CPPFLAGS" fi -dnl For AC_FUNC_GETLOADAVG, at least: -AC_CONFIG_LIBOBJ_DIR(src) - dnl Do this early because it can frob feature test macros for Unix-98 &c. AC_SYS_LARGEFILE @@ -2668,8 +2665,6 @@ AC_CHECK_HEADERS(sys/un.h) -AC_FUNC_GETLOADAVG - AC_FUNC_FSEEKO AC_FUNC_GETPGRP @@ -3118,7 +3113,6 @@ S_FILE="\$(srcdir)/${opsysfile}" AC_SUBST(M_FILE) AC_SUBST(S_FILE) -AC_SUBST(GETLOADAVG_LIBS) AC_SUBST(ns_appdir) AC_SUBST(ns_appbindir) AC_SUBST(ns_appresdir) === modified file 'lib/Makefile.in' --- lib/Makefile.in 2011-02-09 01:40:01 +0000 +++ lib/Makefile.in 2011-02-16 00:33:44 +0000 @@ -24,7 +24,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files dtoastr getopt-gnu ignore-value mktime strftime +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files dtoastr getloadavg getopt-gnu ignore-value mktime strftime VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -51,14 +51,15 @@ ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/c-strtod.m4 $(top_srcdir)/m4/extensions.m4 \ - $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gl-comp.m4 \ - $(top_srcdir)/m4/gnulib-common.m4 \ + $(top_srcdir)/m4/getloadavg.m4 $(top_srcdir)/m4/getopt.m4 \ + $(top_srcdir)/m4/gl-comp.m4 $(top_srcdir)/m4/gnulib-common.m4 \ $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/mktime.m4 \ $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/stdbool.m4 \ - $(top_srcdir)/m4/stddef_h.m4 $(top_srcdir)/m4/strftime.m4 \ - $(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \ - $(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \ - $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.in + $(top_srcdir)/m4/stddef_h.m4 $(top_srcdir)/m4/stdlib_h.m4 \ + $(top_srcdir)/m4/strftime.m4 $(top_srcdir)/m4/time_h.m4 \ + $(top_srcdir)/m4/time_r.m4 $(top_srcdir)/m4/tm_gmtoff.m4 \ + $(top_srcdir)/m4/unistd_h.m4 $(top_srcdir)/m4/wchar_t.m4 \ + $(top_srcdir)/configure.in am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs @@ -134,6 +135,9 @@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ GETOPT_H = @GETOPT_H@ GMALLOC_OBJ = @GMALLOC_OBJ@ +GNULIB_ATOLL = @GNULIB_ATOLL@ +GNULIB_CALLOC_POSIX = @GNULIB_CALLOC_POSIX@ +GNULIB_CANONICALIZE_FILE_NAME = @GNULIB_CANONICALIZE_FILE_NAME@ GNULIB_CHOWN = @GNULIB_CHOWN@ GNULIB_CLOSE = @GNULIB_CLOSE@ GNULIB_DUP2 = @GNULIB_DUP2@ @@ -150,27 +154,47 @@ GNULIB_GETDTABLESIZE = @GNULIB_GETDTABLESIZE@ GNULIB_GETGROUPS = @GNULIB_GETGROUPS@ GNULIB_GETHOSTNAME = @GNULIB_GETHOSTNAME@ +GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@ GNULIB_GETLOGIN = @GNULIB_GETLOGIN@ GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@ GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@ +GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@ +GNULIB_GRANTPT = @GNULIB_GRANTPT@ GNULIB_LCHOWN = @GNULIB_LCHOWN@ GNULIB_LINK = @GNULIB_LINK@ GNULIB_LINKAT = @GNULIB_LINKAT@ GNULIB_LSEEK = @GNULIB_LSEEK@ +GNULIB_MALLOC_POSIX = @GNULIB_MALLOC_POSIX@ +GNULIB_MKDTEMP = @GNULIB_MKDTEMP@ +GNULIB_MKOSTEMP = @GNULIB_MKOSTEMP@ +GNULIB_MKOSTEMPS = @GNULIB_MKOSTEMPS@ +GNULIB_MKSTEMP = @GNULIB_MKSTEMP@ +GNULIB_MKSTEMPS = @GNULIB_MKSTEMPS@ GNULIB_MKTIME = @GNULIB_MKTIME@ GNULIB_NANOSLEEP = @GNULIB_NANOSLEEP@ GNULIB_PIPE = @GNULIB_PIPE@ GNULIB_PIPE2 = @GNULIB_PIPE2@ GNULIB_PREAD = @GNULIB_PREAD@ +GNULIB_PTSNAME = @GNULIB_PTSNAME@ +GNULIB_PUTENV = @GNULIB_PUTENV@ GNULIB_PWRITE = @GNULIB_PWRITE@ +GNULIB_RANDOM_R = @GNULIB_RANDOM_R@ GNULIB_READLINK = @GNULIB_READLINK@ GNULIB_READLINKAT = @GNULIB_READLINKAT@ +GNULIB_REALLOC_POSIX = @GNULIB_REALLOC_POSIX@ +GNULIB_REALPATH = @GNULIB_REALPATH@ GNULIB_RMDIR = @GNULIB_RMDIR@ +GNULIB_RPMATCH = @GNULIB_RPMATCH@ +GNULIB_SETENV = @GNULIB_SETENV@ GNULIB_SLEEP = @GNULIB_SLEEP@ GNULIB_STRPTIME = @GNULIB_STRPTIME@ +GNULIB_STRTOD = @GNULIB_STRTOD@ +GNULIB_STRTOLL = @GNULIB_STRTOLL@ +GNULIB_STRTOULL = @GNULIB_STRTOULL@ GNULIB_SYMLINK = @GNULIB_SYMLINK@ GNULIB_SYMLINKAT = @GNULIB_SYMLINKAT@ +GNULIB_SYSTEM_POSIX = @GNULIB_SYSTEM_POSIX@ GNULIB_TIMEGM = @GNULIB_TIMEGM@ GNULIB_TIME_R = @GNULIB_TIME_R@ GNULIB_TTYNAME_R = @GNULIB_TTYNAME_R@ @@ -178,8 +202,11 @@ GNULIB_UNISTD_H_SIGPIPE = @GNULIB_UNISTD_H_SIGPIPE@ GNULIB_UNLINK = @GNULIB_UNLINK@ GNULIB_UNLINKAT = @GNULIB_UNLINKAT@ +GNULIB_UNLOCKPT = @GNULIB_UNLOCKPT@ +GNULIB_UNSETENV = @GNULIB_UNSETENV@ GNULIB_USLEEP = @GNULIB_USLEEP@ GNULIB_WRITE = @GNULIB_WRITE@ +GNULIB__EXIT = @GNULIB__EXIT@ GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@ GREP = @GREP@ GTK_CFLAGS = @GTK_CFLAGS@ @@ -187,15 +214,20 @@ GTK_OBJ = @GTK_OBJ@ GZIP_INFO = @GZIP_INFO@ GZIP_PROG = @GZIP_PROG@ +HAVE_ATOLL = @HAVE_ATOLL@ +HAVE_CANONICALIZE_FILE_NAME = @HAVE_CANONICALIZE_FILE_NAME@ HAVE_CHOWN = @HAVE_CHOWN@ HAVE_DECL_ENVIRON = @HAVE_DECL_ENVIRON@ HAVE_DECL_FCHDIR = @HAVE_DECL_FCHDIR@ HAVE_DECL_GETDOMAINNAME = @HAVE_DECL_GETDOMAINNAME@ +HAVE_DECL_GETLOADAVG = @HAVE_DECL_GETLOADAVG@ HAVE_DECL_GETLOGIN_R = @HAVE_DECL_GETLOGIN_R@ HAVE_DECL_GETPAGESIZE = @HAVE_DECL_GETPAGESIZE@ HAVE_DECL_GETUSERSHELL = @HAVE_DECL_GETUSERSHELL@ HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@ +HAVE_DECL_SETENV = @HAVE_DECL_SETENV@ HAVE_DECL_TTYNAME_R = @HAVE_DECL_TTYNAME_R@ +HAVE_DECL_UNSETENV = @HAVE_DECL_UNSETENV@ HAVE_DUP2 = @HAVE_DUP2@ HAVE_DUP3 = @HAVE_DUP3@ HAVE_EUIDACCESS = @HAVE_EUIDACCESS@ @@ -210,30 +242,50 @@ HAVE_GETLOGIN = @HAVE_GETLOGIN@ HAVE_GETOPT_H = @HAVE_GETOPT_H@ HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@ +HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ +HAVE_GRANTPT = @HAVE_GRANTPT@ HAVE_LCHOWN = @HAVE_LCHOWN@ HAVE_LINK = @HAVE_LINK@ HAVE_LINKAT = @HAVE_LINKAT@ HAVE_MAKEINFO = @HAVE_MAKEINFO@ +HAVE_MKDTEMP = @HAVE_MKDTEMP@ +HAVE_MKOSTEMP = @HAVE_MKOSTEMP@ +HAVE_MKOSTEMPS = @HAVE_MKOSTEMPS@ +HAVE_MKSTEMP = @HAVE_MKSTEMP@ +HAVE_MKSTEMPS = @HAVE_MKSTEMPS@ HAVE_NANOSLEEP = @HAVE_NANOSLEEP@ HAVE_OS_H = @HAVE_OS_H@ HAVE_PIPE = @HAVE_PIPE@ HAVE_PIPE2 = @HAVE_PIPE2@ HAVE_PREAD = @HAVE_PREAD@ +HAVE_PTSNAME = @HAVE_PTSNAME@ HAVE_PWRITE = @HAVE_PWRITE@ +HAVE_RANDOM_H = @HAVE_RANDOM_H@ +HAVE_RANDOM_R = @HAVE_RANDOM_R@ HAVE_READLINK = @HAVE_READLINK@ HAVE_READLINKAT = @HAVE_READLINKAT@ +HAVE_REALPATH = @HAVE_REALPATH@ +HAVE_RPMATCH = @HAVE_RPMATCH@ +HAVE_SETENV = @HAVE_SETENV@ HAVE_SLEEP = @HAVE_SLEEP@ HAVE_STRPTIME = @HAVE_STRPTIME@ +HAVE_STRTOD = @HAVE_STRTOD@ +HAVE_STRTOLL = @HAVE_STRTOLL@ +HAVE_STRTOULL = @HAVE_STRTOULL@ +HAVE_STRUCT_RANDOM_DATA = @HAVE_STRUCT_RANDOM_DATA@ HAVE_SYMLINK = @HAVE_SYMLINK@ HAVE_SYMLINKAT = @HAVE_SYMLINKAT@ +HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@ HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@ HAVE_TIMEGM = @HAVE_TIMEGM@ HAVE_UNISTD_H = @HAVE_UNISTD_H@ HAVE_UNLINKAT = @HAVE_UNLINKAT@ +HAVE_UNLOCKPT = @HAVE_UNLOCKPT@ HAVE_USLEEP = @HAVE_USLEEP@ HAVE_WCHAR_T = @HAVE_WCHAR_T@ HAVE_XSERVER = @HAVE_XSERVER@ HAVE__BOOL = @HAVE__BOOL@ +HAVE__EXIT = @HAVE__EXIT@ IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@ IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@ INCLUDE_NEXT = @INCLUDE_NEXT@ @@ -244,7 +296,6 @@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -KMEM_GROUP = @KMEM_GROUP@ KRB4LIB = @KRB4LIB@ KRB5LIB = @KRB5LIB@ LDFLAGS = @LDFLAGS@ @@ -297,13 +348,14 @@ MKDIR_P = @MKDIR_P@ MOUSE_SUPPORT = @MOUSE_SUPPORT@ M_FILE = @M_FILE@ -NEED_SETGID = @NEED_SETGID@ NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@ +NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@ NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@ NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ NEXT_STDDEF_H = @NEXT_STDDEF_H@ +NEXT_STDLIB_H = @NEXT_STDLIB_H@ NEXT_TIME_H = @NEXT_TIME_H@ NEXT_UNISTD_H = @NEXT_UNISTD_H@ NS_OBJ = @NS_OBJ@ @@ -331,6 +383,8 @@ PTHREAD_H_DEFINES_STRUCT_TIMESPEC = @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@ RALLOC_OBJ = @RALLOC_OBJ@ RANLIB = @RANLIB@ +REPLACE_CALLOC = @REPLACE_CALLOC@ +REPLACE_CANONICALIZE_FILE_NAME = @REPLACE_CANONICALIZE_FILE_NAME@ REPLACE_CHOWN = @REPLACE_CHOWN@ REPLACE_CLOSE = @REPLACE_CLOSE@ REPLACE_DUP = @REPLACE_DUP@ @@ -346,19 +400,27 @@ REPLACE_LINKAT = @REPLACE_LINKAT@ REPLACE_LOCALTIME_R = @REPLACE_LOCALTIME_R@ REPLACE_LSEEK = @REPLACE_LSEEK@ +REPLACE_MALLOC = @REPLACE_MALLOC@ +REPLACE_MKSTEMP = @REPLACE_MKSTEMP@ REPLACE_MKTIME = @REPLACE_MKTIME@ REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@ REPLACE_NULL = @REPLACE_NULL@ REPLACE_PREAD = @REPLACE_PREAD@ +REPLACE_PUTENV = @REPLACE_PUTENV@ REPLACE_PWRITE = @REPLACE_PWRITE@ REPLACE_READLINK = @REPLACE_READLINK@ +REPLACE_REALLOC = @REPLACE_REALLOC@ +REPLACE_REALPATH = @REPLACE_REALPATH@ REPLACE_RMDIR = @REPLACE_RMDIR@ +REPLACE_SETENV = @REPLACE_SETENV@ REPLACE_SLEEP = @REPLACE_SLEEP@ +REPLACE_STRTOD = @REPLACE_STRTOD@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ REPLACE_UNLINK = @REPLACE_UNLINK@ REPLACE_UNLINKAT = @REPLACE_UNLINKAT@ +REPLACE_UNSETENV = @REPLACE_UNSETENV@ REPLACE_USLEEP = @REPLACE_USLEEP@ REPLACE_WRITE = @REPLACE_WRITE@ RSVG_CFLAGS = @RSVG_CFLAGS@ @@ -472,23 +534,23 @@ # present in all Makefile.am that need it. This is ensured by the applicability # 'all' defined above. BUILT_SOURCES = arg-nonnull.h c++defs.h $(GETOPT_H) $(STDBOOL_H) \ - $(STDDEF_H) time.h unistd.h warn-on-use.h + $(STDDEF_H) stdlib.h time.h unistd.h warn-on-use.h EXTRA_DIST = $(top_srcdir)/./arg-nonnull.h $(top_srcdir)/./c++defs.h \ - ftoastr.c ftoastr.h getopt.c getopt.in.h getopt1.c \ - getopt_int.h intprops.h mktime-internal.h mktime.c \ - stdbool.in.h stddef.in.h strftime.c strftime.h time.in.h \ - time_r.c unistd.in.h $(top_srcdir)/./warn-on-use.h + ftoastr.c ftoastr.h getloadavg.c getopt.c getopt.in.h \ + getopt1.c getopt_int.h intprops.h mktime-internal.h mktime.c \ + stdbool.in.h stddef.in.h stdlib.in.h strftime.c strftime.h \ + time.in.h time_r.c unistd.in.h $(top_srcdir)/./warn-on-use.h MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \ c++defs.h c++defs.h-t getopt.h getopt.h-t stdbool.h \ - stdbool.h-t stddef.h stddef.h-t time.h time.h-t unistd.h \ - unistd.h-t warn-on-use.h warn-on-use.h-t + stdbool.h-t stddef.h stddef.h-t stdlib.h stdlib.h-t time.h \ + time.h-t unistd.h unistd.h-t warn-on-use.h warn-on-use.h-t noinst_LIBRARIES = libgnu.a DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src libgnu_a_SOURCES = dtoastr.c gettext.h ignore-value.h libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) -EXTRA_libgnu_a_SOURCES = ftoastr.c getopt.c getopt1.c mktime.c \ - strftime.c time_r.c +EXTRA_libgnu_a_SOURCES = ftoastr.c getloadavg.c getopt.c getopt1.c \ + mktime.c strftime.c time_r.c ARG_NONNULL_H = arg-nonnull.h CXXDEFS_H = c++defs.h WARN_ON_USE_H = warn-on-use.h @@ -543,6 +605,7 @@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ @@ -819,6 +882,82 @@ } > $@-t && \ mv $@-t $@ +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \ + -e 's|@''GNULIB__EXIT''@|$(GNULIB__EXIT)|g' \ + -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \ + -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \ + -e 's|@''GNULIB_CANONICALIZE_FILE_NAME''@|$(GNULIB_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \ + -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \ + -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \ + -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \ + -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \ + -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \ + -e 's|@''GNULIB_MKSTEMPS''@|$(GNULIB_MKSTEMPS)|g' \ + -e 's|@''GNULIB_PTSNAME''@|$(GNULIB_PTSNAME)|g' \ + -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|g' \ + -e 's|@''GNULIB_RANDOM_R''@|$(GNULIB_RANDOM_R)|g' \ + -e 's|@''GNULIB_REALLOC_POSIX''@|$(GNULIB_REALLOC_POSIX)|g' \ + -e 's|@''GNULIB_REALPATH''@|$(GNULIB_REALPATH)|g' \ + -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \ + -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \ + -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \ + -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \ + -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \ + -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \ + -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \ + -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \ + < $(srcdir)/stdlib.in.h | \ + sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \ + -e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \ + -e 's|@''HAVE_CANONICALIZE_FILE_NAME''@|$(HAVE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ + -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ + -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ + -e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMP''@|$(HAVE_MKOSTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \ + -e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \ + -e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \ + -e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \ + -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \ + -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \ + -e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \ + -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \ + -e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \ + -e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \ + -e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \ + -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \ + -e 's|@''HAVE_STRUCT_RANDOM_DATA''@|$(HAVE_STRUCT_RANDOM_DATA)|g' \ + -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ + -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ + -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ + -e 's|@''REPLACE_CALLOC''@|$(REPLACE_CALLOC)|g' \ + -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ + -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ + -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ + -e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \ + -e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \ + -e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \ + -e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \ + -e 's|@''REPLACE_UNSETENV''@|$(REPLACE_UNSETENV)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ + } > $@-t && \ + mv $@-t $@ + # We need the following in order to create when the system # doesn't have one that works with the given compiler. time.h: time.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) === renamed file 'src/getloadavg.c' => 'lib/getloadavg.c' --- src/getloadavg.c 2011-01-17 19:01:01 +0000 +++ lib/getloadavg.c 2011-02-16 00:33:44 +0000 @@ -1,15 +1,15 @@ /* Get the system load averages. - Copyright (C) 1985, 1986, 1987, 1988, 1989, 1991, 1992, 1993, 1994, 1995, - 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 - Free Software Foundation, Inc. + + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2011 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. - This program is free software; you can redistribute it and/or modify + This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -17,62 +17,62 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, - USA. */ + along with this program. If not, see . */ /* Compile-time symbols that this file uses: - HAVE_PSTAT_GETDYNAMIC Define this if your system has the + HAVE_PSTAT_GETDYNAMIC Define this if your system has the pstat_getdynamic function. I think it - is unique to HPUX9. The best way to get the - definition is through the AC_FUNC_GETLOADAVG - macro that comes with autoconf 2.13 or newer. - If that isn't an option, then just put - AC_CHECK_FUNCS(pstat_getdynamic) in your - configure.in file. - FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. - KERNEL_FILE Pathname of the kernel to nlist. - LDAV_CVT() Scale the load average from the kernel. - Returns a double. - LDAV_SYMBOL Name of kernel symbol giving load average. - LOAD_AVE_TYPE Type of the load average array in the kernel. - Must be defined unless one of - apollo, DGUX, NeXT, or UMAX is defined; + is unique to HPUX9. The best way to get the + definition is through the AC_FUNC_GETLOADAVG + macro that comes with autoconf 2.13 or newer. + If that isn't an option, then just put + AC_CHECK_FUNCS(pstat_getdynamic) in your + configure.in file. + HAVE_LIBPERFSTAT Define this if your system has the + perfstat_cpu_total function in libperfstat (AIX). + FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. + KERNEL_FILE Name of the kernel file to nlist. + LDAV_CVT() Scale the load average from the kernel. + Returns a double. + LDAV_SYMBOL Name of kernel symbol giving load average. + LOAD_AVE_TYPE Type of the load average array in the kernel. + Must be defined unless one of + apollo, DGUX, NeXT, or UMAX is defined; or we have libkstat; - otherwise, no load average is available. + otherwise, no load average is available. HAVE_NLIST_H nlist.h is available. NLIST_STRUCT defaults to this. - NLIST_STRUCT Include nlist.h, not a.out.h, and - the nlist n_name element is a pointer, - not an array. + NLIST_STRUCT Include nlist.h, not a.out.h. + N_NAME_POINTER The nlist n_name element is a pointer, + not an array. HAVE_STRUCT_NLIST_N_UN_N_NAME `n_un.n_name' is member of `struct nlist'. - LINUX_LDAV_FILE [__linux__]: File containing load averages. - HAVE_LOCALE_H locale.h is available. - HAVE_SETLOCALE The `setlocale' function is available. + LINUX_LDAV_FILE [__linux__, __CYGWIN__]: File containing + load averages. Specific system predefines this file uses, aside from setting default values if not emacs: apollo - BSD Real BSD, not just BSD-like. + BSD Real BSD, not just BSD-like. convex DGUX - eunice UNIX emulator under VMS. + eunice UNIX emulator under VMS. hpux - __MSDOS__ No-op for MSDOS. + __MSDOS__ No-op for MSDOS. NeXT sgi - sequent Sequent Dynix 3.x.x (BSD) - _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) + sequent Sequent Dynix 3.x.x (BSD) + _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) sony_news NEWS-OS (works at least for 4.1C) UMAX UMAX4_3 VMS - WINDOWS32 No-op for Windows95/NT. - __linux__ Linux: assumes /proc filesystem mounted. - Support from Michael K. Johnson. - __NetBSD__ NetBSD: assumes /kern filesystem mounted. + WINDOWS32 No-op for Windows95/NT. + __linux__ Linux: assumes /proc file system mounted. + Support from Michael K. Johnson. + __CYGWIN__ Cygwin emulates linux /proc/loadavg. + __NetBSD__ NetBSD: assumes /kern file system mounted. In addition, to avoid nesting many #ifdefs, we internally set LDAV_DONE to indicate that the load average has been computed. @@ -80,41 +80,30 @@ We also #define LDAV_PRIVILEGED if a program will require special installation to be able to call getloadavg. */ -/* This should always be first. */ -#ifdef HAVE_CONFIG_H +/* "configure" defines CONFIGURING_GETLOADAVG to sidestep problems + with partially-configured source directories. */ + +#ifndef CONFIGURING_GETLOADAVG # include +# include #endif -#include +/* Specification. */ +#include + +#include +#include + +# include /* Both the Emacs and non-Emacs sections want this. Some configuration files' definitions for the LOAD_AVE_CVT macro (like sparc.h's) use macros like FSCALE, defined here. */ -#if defined (unix) || defined (__unix) -# include -#endif - - -/* Exclude all the code except the test program at the end - if the system has its own `getloadavg' function. - - The declaration of `errno' is needed by the test program - as well as the function itself, so it comes first. */ - -#include - -#ifndef errno -extern int errno; -#endif - -#ifdef HAVE_LOCALE_H -# include -#endif -#ifndef HAVE_SETLOCALE -# define setlocale(Category, Locale) /* empty */ -#endif - -#ifndef HAVE_GETLOADAVG +# if defined (unix) || defined (__unix) +# include +# endif + +# include "intprops.h" /* The existing Emacs configuration files define a macro called LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and @@ -126,7 +115,7 @@ LOAD_AVE_CVT, but future machine config files should just define LDAV_CVT directly. */ -# if !defined(LDAV_CVT) && defined(LOAD_AVE_CVT) +# if !defined (LDAV_CVT) && defined (LOAD_AVE_CVT) # define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0) # endif @@ -170,11 +159,11 @@ # define sun # endif -# if defined(hp300) && !defined(hpux) +# if defined (hp300) && !defined (hpux) # define MORE_BSD # endif -# if defined(ultrix) && defined(mips) +# if defined (ultrix) && defined (mips) # define decstation # endif @@ -182,7 +171,7 @@ # define SVR4 # endif -# if (defined(sun) && defined(SVR4)) || defined (SOLARIS2) +# if (defined (sun) && defined (SVR4)) || defined (SOLARIS2) # define SUNOS_5 # endif @@ -192,6 +181,8 @@ # include # include # include +/* Tru64 4.0D's table.h redefines sys */ +# undef sys # endif # if defined (__osf__) && (defined (mips) || defined (__mips__)) @@ -203,7 +194,7 @@ default, but _MACH_IND_SYS_TYPES is defined in . Combine that with a couple of other things and we'll have a unique match. */ # if !defined (tek4300) && defined (unix) && defined (m68k) && defined (mc68000) && defined (mc68020) && defined (_MACH_IND_SYS_TYPES) -# define tek4300 /* Define by emacs, but not by other users. */ +# define tek4300 /* Define by emacs, but not by other users. */ # endif @@ -254,11 +245,11 @@ # define LOAD_AVE_TYPE long # endif -# if defined(alliant) && defined(i860) /* Alliant FX/2800 */ +# if defined (alliant) && defined (i860) /* Alliant FX/2800 */ # define LOAD_AVE_TYPE long # endif -# ifdef _AIX +# if defined _AIX && ! defined HAVE_LIBPERFSTAT # define LOAD_AVE_TYPE long # endif @@ -278,7 +269,7 @@ # define FSCALE 1024.0 # endif -# if defined(alliant) && defined(i860) /* Alliant FX/2800 */ +# if defined (alliant) && defined (i860) /* Alliant FX/2800 */ /* defines an incorrect value for FSCALE on an Alliant FX/2800 Concentrix 2.2, according to ghazi@noc.rutgers.edu. */ # undef FSCALE @@ -286,7 +277,7 @@ # endif -# ifndef FSCALE +# ifndef FSCALE /* SunOS and some others define FSCALE in sys/param.h. */ @@ -294,7 +285,7 @@ # define FSCALE 2048.0 # endif -# if defined(MIPS) || defined(SVR4) || defined(decstation) +# if defined (MIPS) || defined (SVR4) || defined (decstation) # define FSCALE 256 # endif @@ -313,11 +304,11 @@ # define FSCALE 100.0 # endif -# ifdef _AIX +# if defined _AIX && !defined HAVE_LIBPERFSTAT # define FSCALE 65536.0 # endif -# endif /* Not FSCALE. */ +# endif /* Not FSCALE. */ # if !defined (LDAV_CVT) && defined (FSCALE) # define LDAV_CVT(n) (((double) (n)) / FSCALE) @@ -329,7 +320,7 @@ # endif # endif -# if defined(sgi) || (defined(mips) && !defined(BSD)) +# if defined (sgi) || (defined (mips) && !defined (BSD)) # define FIXUP_KERNEL_SYMBOL_ADDR(nl) ((nl)[0].n_value &= ~(1 << 31)) # endif @@ -342,7 +333,7 @@ # define KERNEL_FILE "/hp-ux" # endif -# if !defined(KERNEL_FILE) && (defined(_SEQUENT_) || defined(MIPS) || defined(SVR4) || defined(ISC) || defined (sgi) || (defined (ardent) && defined (titan))) +# if !defined (KERNEL_FILE) && (defined (_SEQUENT_) || defined (MIPS) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (ardent) && defined (titan))) # define KERNEL_FILE "/unix" # endif @@ -351,22 +342,21 @@ # define LDAV_SYMBOL "_Loadavg" # endif -# if !defined(LDAV_SYMBOL) && ((defined(hpux) && !defined(hp9000s300)) || defined(_SEQUENT_) || defined(SVR4) || defined(ISC) || defined(sgi) || (defined (ardent) && defined (titan)) || defined (_AIX)) +# if !defined (LDAV_SYMBOL) && ((defined (hpux) && !defined (hp9000s300)) || defined (_SEQUENT_) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (ardent) && defined (titan)) || (defined (_AIX) && !defined(HAVE_LIBPERFSTAT))) # define LDAV_SYMBOL "avenrun" # endif # include -# include /* LOAD_AVE_TYPE should only get defined if we're going to use the nlist method. */ -# if !defined(LOAD_AVE_TYPE) && (defined(BSD) || defined(LDAV_CVT) || defined(KERNEL_FILE) || defined(LDAV_SYMBOL)) +# if !defined (LOAD_AVE_TYPE) && (defined (BSD) || defined (LDAV_CVT) || defined (KERNEL_FILE) || defined (LDAV_SYMBOL)) # define LOAD_AVE_TYPE double # endif # ifdef LOAD_AVE_TYPE -# ifndef VMS +# ifndef __VMS # ifndef __linux__ # ifndef NLIST_STRUCT # include @@ -375,7 +365,6 @@ # endif /* NLIST_STRUCT */ # ifdef SUNOS_5 -# include # include # include # endif @@ -393,7 +382,7 @@ # endif /* LDAV_SYMBOL */ # endif /* __linux__ */ -# else /* VMS */ +# else /* __VMS */ # ifndef eunice # include @@ -401,7 +390,7 @@ # else /* eunice */ # include # endif /* eunice */ -# endif /* VMS */ +# endif /* __VMS */ # ifndef LDAV_CVT # define LDAV_CVT(n) ((double) (n)) @@ -409,7 +398,16 @@ # endif /* LOAD_AVE_TYPE */ -# if defined(__GNU__) && !defined (NeXT) +# if defined HAVE_LIBPERFSTAT +# include +# include +# include +# ifndef SBITS +# define SBITS 16 +# endif +# endif + +# if defined (__GNU__) && !defined (NeXT) /* Note that NeXT Openstep defines __GNU__ even though it should not. */ /* GNU system acts much like NeXT, for load average purposes, but not exactly. */ @@ -430,7 +428,6 @@ # endif /* sgi */ # ifdef UMAX -# include # include # include # include @@ -456,17 +453,16 @@ # include # endif -# if defined(HAVE_FCNTL_H) || defined(_POSIX_VERSION) +# if (defined __linux__ || defined __CYGWIN__ || defined SUNOS_5 \ + || (defined LOAD_AVE_TYPE && ! defined __VMS)) # include -# else -# include # endif /* Avoid static vars inside a function since in HPUX they dump as pure. */ # ifdef NeXT static processor_set_t default_set; -static int getloadavg_initialized; +static bool getloadavg_initialized; # endif /* NeXT */ # ifdef UMAX @@ -475,44 +471,40 @@ # endif /* UMAX */ # ifdef DGUX -static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */ +static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */ # endif /* DGUX */ -#if !defined(HAVE_LIBKSTAT) && defined(LOAD_AVE_TYPE) +# if !defined (HAVE_LIBKSTAT) && defined (LOAD_AVE_TYPE) /* File descriptor open to /dev/kmem or VMS load ave driver. */ static int channel; -/* Nonzero if channel is valid. */ -static int getloadavg_initialized; +/* True if channel is valid. */ +static bool getloadavg_initialized; /* Offset in kmem to seek to read load average, or 0 means invalid. */ static long offset; -# if !defined(VMS) && !defined(sgi) && !defined(__linux__) +# if ! defined __VMS && ! defined sgi && ! defined __linux__ static struct nlist name_list[2]; -# endif /* Not VMS or sgi */ +# endif # ifdef SUNOS_5 static kvm_t *kd; # endif /* SUNOS_5 */ -#endif /* LOAD_AVE_TYPE && !HAVE_LIBKSTAT */ +# endif /* LOAD_AVE_TYPE && !HAVE_LIBKSTAT */ /* Put the 1 minute, 5 minute and 15 minute load averages into the first NELEM elements of LOADAVG. Return the number written (never more than 3, but may be less than NELEM), - or -1 if an error occurred. */ + or -1 (setting errno) if an error occurred. */ int -getloadavg (loadavg, nelem) - double loadavg[]; - int nelem; +getloadavg (double loadavg[], int nelem) { - int elem = 0; /* Return value. */ + int elem = 0; /* Return value. */ # ifdef NO_GET_LOAD_AVG # define LDAV_DONE - /* Set errno to zero to indicate that there was no particular error; - this function just can't work at all on this system. */ - errno = 0; + errno = ENOSYS; elem = -1; # endif @@ -522,12 +514,13 @@ kstat_ctl_t *kc; kstat_t *ksp; kstat_named_t *kn; + int saved_errno; kc = kstat_open (); if (kc == 0) return -1; ksp = kstat_lookup (kc, "unix", 0, "system_misc"); - if (ksp == 0 ) + if (ksp == 0) return -1; if (kstat_read (kc, ksp, 0) == -1) return -1; @@ -542,25 +535,27 @@ } if (nelem >= 1) - loadavg[elem++] = (double) kn->value.ul/FSCALE; + loadavg[elem++] = (double) kn->value.ul / FSCALE; if (nelem >= 2) { kn = kstat_data_lookup (ksp, "avenrun_5min"); if (kn != 0) - { - loadavg[elem++] = (double) kn->value.ul/FSCALE; + { + loadavg[elem++] = (double) kn->value.ul / FSCALE; - if (nelem >= 3) - { - kn = kstat_data_lookup (ksp, "avenrun_15min"); - if (kn != 0) - loadavg[elem++] = (double) kn->value.ul/FSCALE; - } - } + if (nelem >= 3) + { + kn = kstat_data_lookup (ksp, "avenrun_15min"); + if (kn != 0) + loadavg[elem++] = (double) kn->value.ul / FSCALE; + } + } } + saved_errno = errno; kstat_close (kc); + errno = saved_errno; # endif /* HAVE_LIBKSTAT */ # if !defined (LDAV_DONE) && defined (hpux) && defined (HAVE_PSTAT_GETDYNAMIC) @@ -580,7 +575,23 @@ # endif /* hpux && HAVE_PSTAT_GETDYNAMIC */ -# if !defined (LDAV_DONE) && defined (__linux__) +# if ! defined LDAV_DONE && defined HAVE_LIBPERFSTAT +# define LDAV_DONE +# undef LOAD_AVE_TYPE +/* Use perfstat_cpu_total because we don't have to be root. */ + { + perfstat_cpu_total_t cpu_stats; + int result = perfstat_cpu_total (NULL, &cpu_stats, sizeof cpu_stats, 1); + if (result == -1) + return result; + loadavg[0] = cpu_stats.loadavg[0] / (double)(1 << SBITS); + loadavg[1] = cpu_stats.loadavg[1] / (double)(1 << SBITS); + loadavg[2] = cpu_stats.loadavg[2] / (double)(1 << SBITS); + elem = 3; + } +# endif + +# if !defined (LDAV_DONE) && (defined (__linux__) || defined (__CYGWIN__)) # define LDAV_DONE # undef LOAD_AVE_TYPE @@ -588,32 +599,54 @@ # define LINUX_LDAV_FILE "/proc/loadavg" # endif - char ldavgbuf[40]; - double load_ave[3]; - int fd, count; + char ldavgbuf[3 * (INT_STRLEN_BOUND (int) + sizeof ".00 ")]; + char const *ptr = ldavgbuf; + int fd, count, saved_errno; fd = open (LINUX_LDAV_FILE, O_RDONLY); if (fd == -1) return -1; - count = read (fd, ldavgbuf, 40); + count = read (fd, ldavgbuf, sizeof ldavgbuf - 1); + saved_errno = errno; (void) close (fd); + errno = saved_errno; if (count <= 0) return -1; - - /* The following sscanf must use the C locale. */ - setlocale (LC_NUMERIC, "C"); - count = sscanf (ldavgbuf, "%lf %lf %lf", - &load_ave[0], &load_ave[1], &load_ave[2]); - setlocale (LC_NUMERIC, ""); - if (count < 1) - return -1; - - for (elem = 0; elem < nelem && elem < count; elem++) - loadavg[elem] = load_ave[elem]; + ldavgbuf[count] = '\0'; + + for (elem = 0; elem < nelem; elem++) + { + double numerator = 0; + double denominator = 1; + + while (*ptr == ' ') + ptr++; + + /* Finish if this number is missing, and report an error if all + were missing. */ + if (! ('0' <= *ptr && *ptr <= '9')) + { + if (elem == 0) + { + errno = ENOTSUP; + return -1; + } + break; + } + + while ('0' <= *ptr && *ptr <= '9') + numerator = 10 * numerator + (*ptr++ - '0'); + + if (*ptr == '.') + for (ptr++; '0' <= *ptr && *ptr <= '9'; ptr++) + numerator = 10 * numerator + (*ptr - '0'), denominator *= 10; + + loadavg[elem++] = numerator / denominator; + } return elem; -# endif /* __linux__ */ +# endif /* __linux__ || __CYGWIN__ */ # if !defined (LDAV_DONE) && defined (__NetBSD__) # define LDAV_DONE @@ -631,11 +664,14 @@ if (fp == NULL) return -1; count = fscanf (fp, "%lu %lu %lu %lu\n", - &load_ave[0], &load_ave[1], &load_ave[2], - &scale); + &load_ave[0], &load_ave[1], &load_ave[2], + &scale); (void) fclose (fp); if (count != 4) - return -1; + { + errno = ENOTSUP; + return -1; + } for (elem = 0; elem < nelem; elem++) loadavg[elem] = (double) load_ave[elem] / (double) scale; @@ -650,7 +686,7 @@ host_t host; struct processor_set_basic_info info; - unsigned info_count; + unsigned int info_count; /* We only know how to get the 1-minute average for this system, so even if the caller asks for more than 1, we only return 1. */ @@ -658,25 +694,28 @@ if (!getloadavg_initialized) { if (processor_set_default (host_self (), &default_set) == KERN_SUCCESS) - getloadavg_initialized = 1; + getloadavg_initialized = true; } if (getloadavg_initialized) { info_count = PROCESSOR_SET_BASIC_INFO_COUNT; if (processor_set_info (default_set, PROCESSOR_SET_BASIC_INFO, &host, - (processor_set_info_t) &info, &info_count) - != KERN_SUCCESS) - getloadavg_initialized = 0; + (processor_set_info_t) &info, &info_count) + != KERN_SUCCESS) + getloadavg_initialized = false; else - { - if (nelem > 0) - loadavg[elem++] = (double) info.load_average / LOAD_SCALE; - } + { + if (nelem > 0) + loadavg[elem++] = (double) info.load_average / LOAD_SCALE; + } } if (!getloadavg_initialized) - return -1; + { + errno = ENOTSUP; + return -1; + } # endif /* NeXT */ # if !defined (LDAV_DONE) && defined (UMAX) @@ -704,24 +743,24 @@ desc.sd_size = sizeof conf; if (inq_stats (1, &desc)) - return -1; + return -1; c = 0; for (i = 0; i < conf.config_maxclass; ++i) - { - struct class_stats stats; - memset (&stats, 0, sizeof stats); - - desc.sd_type = CPUTYPE_CLASS; - desc.sd_objid = i; - desc.sd_addr = (char *) &stats; - desc.sd_size = sizeof stats; - - if (inq_stats (1, &desc)) - return -1; - - c += stats.class_numcpus; - } + { + struct class_stats stats; + memset (&stats, 0, sizeof stats); + + desc.sd_type = CPUTYPE_CLASS; + desc.sd_objid = i; + desc.sd_addr = (char *) &stats; + desc.sd_size = sizeof stats; + + if (inq_stats (1, &desc)) + return -1; + + c += stats.class_numcpus; + } cpus = c; samples = cpus < 2 ? 3 : (2 * cpus / 3); } @@ -742,7 +781,7 @@ { load += proc_sum_data.ps_nrun[j]; if (j++ == PS_NRUNSIZE) - j = 0; + j = 0; } if (nelem > 0) @@ -755,8 +794,8 @@ it's not supposed to fail. The first argument is for no apparent reason of type `long int *'. */ dg_sys_info ((long int *) &load_info, - DG_SYS_INFO_LOAD_INFO_TYPE, - DG_SYS_INFO_LOAD_VERSION_0); + DG_SYS_INFO_LOAD_INFO_TYPE, + DG_SYS_INFO_LOAD_VERSION_0); if (nelem > 0) loadavg[elem++] = load_info.one_minute; @@ -800,7 +839,7 @@ = (load_ave.tl_lscale == 0 ? load_ave.tl_avenrun.d[0] : (load_ave.tl_avenrun.l[0] / (double) load_ave.tl_lscale)); -# endif /* OSF_MIPS */ +# endif /* OSF_MIPS */ # if !defined (LDAV_DONE) && (defined (__MSDOS__) || defined (WINDOWS32)) # define LDAV_DONE @@ -820,15 +859,15 @@ for (elem = 0; elem < nelem; elem++) loadavg[elem] = (load_ave.tl_lscale == 0 - ? load_ave.tl_avenrun.d[elem] - : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); + ? load_ave.tl_avenrun.d[elem] + : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); # endif /* OSF_ALPHA */ -# if !defined (LDAV_DONE) && defined (VMS) +# if ! defined LDAV_DONE && defined __VMS /* VMS specific code -- read from the Load Ave driver. */ LOAD_AVE_TYPE load_ave[3]; - static int getloadavg_initialized = 0; + static bool getloadavg_initialized; # ifdef eunice struct { @@ -848,27 +887,30 @@ $DESCRIPTOR (descriptor, "LAV0:"); # endif if (sys$assign (&descriptor, &channel, 0, 0) & 1) - getloadavg_initialized = 1; + getloadavg_initialized = true; } /* Read the load average vector. */ if (getloadavg_initialized && !(sys$qiow (0, channel, IO$_READVBLK, 0, 0, 0, - load_ave, 12, 0, 0, 0, 0) & 1)) + load_ave, 12, 0, 0, 0, 0) & 1)) { sys$dassgn (channel); - getloadavg_initialized = 0; + getloadavg_initialized = false; } if (!getloadavg_initialized) - return -1; -# endif /* VMS */ + { + errno = ENOTSUP; + return -1; + } +# endif /* ! defined LDAV_DONE && defined __VMS */ -# if !defined (LDAV_DONE) && defined(LOAD_AVE_TYPE) && !defined(VMS) +# if ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS /* UNIX-specific code -- read the average from /dev/kmem. */ -# define LDAV_PRIVILEGED /* This code requires special installation. */ +# define LDAV_PRIVILEGED /* This code requires special installation. */ LOAD_AVE_TYPE load_ave[3]; @@ -876,7 +918,7 @@ if (offset == 0) { # ifndef sgi -# ifndef NLIST_STRUCT +# if ! defined NLIST_STRUCT || ! defined N_NAME_POINTER strcpy (name_list[0].n_name, LDAV_SYMBOL); strcpy (name_list[1].n_name, ""); # else /* NLIST_STRUCT */ @@ -892,25 +934,25 @@ # ifndef SUNOS_5 if ( # if !(defined (_AIX) && !defined (ps2)) - nlist (KERNEL_FILE, name_list) + nlist (KERNEL_FILE, name_list) # else /* _AIX */ - knlist (name_list, 1, sizeof (name_list[0])) + knlist (name_list, 1, sizeof (name_list[0])) # endif - >= 0) - /* Omit "&& name_list[0].n_type != 0 " -- it breaks on Sun386i. */ - { + >= 0) + /* Omit "&& name_list[0].n_type != 0 " -- it breaks on Sun386i. */ + { # ifdef FIXUP_KERNEL_SYMBOL_ADDR - FIXUP_KERNEL_SYMBOL_ADDR (name_list); + FIXUP_KERNEL_SYMBOL_ADDR (name_list); # endif - offset = name_list[0].n_value; - } + offset = name_list[0].n_value; + } # endif /* !SUNOS_5 */ # else /* sgi */ int ldav_off; ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); if (ldav_off != -1) - offset = (long) ldav_off & 0x7fffffff; + offset = (long int) ldav_off & 0x7fffffff; # endif /* sgi */ } @@ -918,30 +960,39 @@ if (!getloadavg_initialized) { # ifndef SUNOS_5 - channel = open ("/dev/kmem", 0); - if (channel >= 0) - { - /* Set the channel to close on exec, so it does not - litter any child's descriptor table. */ -# ifdef F_SETFD -# ifndef FD_CLOEXEC -# define FD_CLOEXEC 1 -# endif - (void) fcntl (channel, F_SETFD, FD_CLOEXEC); -# endif - getloadavg_initialized = 1; - } + /* Set the channel to close on exec, so it does not + litter any child's descriptor table. */ +# ifndef O_CLOEXEC +# define O_CLOEXEC 0 +# endif + int fd = open ("/dev/kmem", O_RDONLY | O_CLOEXEC); + if (0 <= fd) + { +# if F_DUPFD_CLOEXEC + if (fd <= STDERR_FILENO) + { + int fd1 = fcntl (fd, F_DUPFD_CLOEXEC, STDERR_FILENO + 1); + close (fd); + fd = fd1; + } +# endif + if (0 <= fd) + { + channel = fd; + getloadavg_initialized = true; + } + } # else /* SUNOS_5 */ /* We pass 0 for the kernel, corefile, and swapfile names - to use the currently running kernel. */ + to use the currently running kernel. */ kd = kvm_open (0, 0, 0, O_RDONLY, 0); if (kd != 0) - { - /* nlist the currently running kernel. */ - kvm_nlist (kd, name_list); - offset = name_list[0].n_value; - getloadavg_initialized = 1; - } + { + /* nlist the currently running kernel. */ + kvm_nlist (kd, name_list); + offset = name_list[0].n_value; + getloadavg_initialized = true; + } # endif /* SUNOS_5 */ } @@ -951,25 +1002,28 @@ /* Try to read the load. */ # ifndef SUNOS_5 if (lseek (channel, offset, 0) == -1L - || read (channel, (char *) load_ave, sizeof (load_ave)) - != sizeof (load_ave)) - { - close (channel); - getloadavg_initialized = 0; - } + || read (channel, (char *) load_ave, sizeof (load_ave)) + != sizeof (load_ave)) + { + close (channel); + getloadavg_initialized = false; + } # else /* SUNOS_5 */ if (kvm_read (kd, offset, (char *) load_ave, sizeof (load_ave)) - != sizeof (load_ave)) + != sizeof (load_ave)) { kvm_close (kd); - getloadavg_initialized = 0; - } + getloadavg_initialized = false; + } # endif /* SUNOS_5 */ } if (offset == 0 || !getloadavg_initialized) - return -1; -# endif /* LOAD_AVE_TYPE and not VMS */ + { + errno = ENOTSUP; + return -1; + } +# endif /* ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS */ # if !defined (LDAV_DONE) && defined (LOAD_AVE_TYPE) /* Including VMS. */ if (nelem > 0) @@ -982,56 +1036,9 @@ # define LDAV_DONE # endif /* !LDAV_DONE && LOAD_AVE_TYPE */ -# ifdef LDAV_DONE +# if !defined LDAV_DONE + errno = ENOSYS; + elem = -1; +# endif return elem; -# else - /* Set errno to zero to indicate that there was no particular error; - this function just can't work at all on this system. */ - errno = 0; - return -1; -# endif -} - -#endif /* ! HAVE_GETLOADAVG */ - -#ifdef TEST -void -main (argc, argv) - int argc; - char **argv; -{ - int naptime = 0; - - if (argc > 1) - naptime = atoi (argv[1]); - - while (1) - { - double avg[3]; - int loads; - - errno = 0; /* Don't be misled if it doesn't set errno. */ - loads = getloadavg (avg, 3); - if (loads == -1) - { - perror ("Error getting load average"); - exit (1); - } - if (loads > 0) - printf ("1-minute: %f ", avg[0]); - if (loads > 1) - printf ("5-minute: %f ", avg[1]); - if (loads > 2) - printf ("15-minute: %f ", avg[2]); - if (loads > 0) - putchar ('\n'); - - if (naptime == 0) - break; - sleep (naptime); - } - - exit (0); -} -#endif /* TEST */ - +} === modified file 'lib/gnulib.mk' --- lib/gnulib.mk 2011-02-09 01:40:01 +0000 +++ lib/gnulib.mk 2011-02-16 00:33:44 +0000 @@ -9,7 +9,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files dtoastr getopt-gnu ignore-value mktime strftime +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files dtoastr getloadavg getopt-gnu ignore-value mktime strftime MOSTLYCLEANFILES += core *.stackdump @@ -79,6 +79,15 @@ ## end gnulib module dtoastr +## begin gnulib module getloadavg + + +EXTRA_DIST += getloadavg.c + +EXTRA_libgnu_a_SOURCES += getloadavg.c + +## end gnulib module getloadavg + ## begin gnulib module getopt-posix BUILT_SOURCES += $(GETOPT_H) @@ -175,6 +184,91 @@ ## end gnulib module stddef +## begin gnulib module stdlib + +BUILT_SOURCES += stdlib.h + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \ + -e 's|@''GNULIB__EXIT''@|$(GNULIB__EXIT)|g' \ + -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \ + -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \ + -e 's|@''GNULIB_CANONICALIZE_FILE_NAME''@|$(GNULIB_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \ + -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \ + -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \ + -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \ + -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \ + -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \ + -e 's|@''GNULIB_MKSTEMPS''@|$(GNULIB_MKSTEMPS)|g' \ + -e 's|@''GNULIB_PTSNAME''@|$(GNULIB_PTSNAME)|g' \ + -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|g' \ + -e 's|@''GNULIB_RANDOM_R''@|$(GNULIB_RANDOM_R)|g' \ + -e 's|@''GNULIB_REALLOC_POSIX''@|$(GNULIB_REALLOC_POSIX)|g' \ + -e 's|@''GNULIB_REALPATH''@|$(GNULIB_REALPATH)|g' \ + -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \ + -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \ + -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \ + -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \ + -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \ + -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \ + -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \ + -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \ + < $(srcdir)/stdlib.in.h | \ + sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \ + -e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \ + -e 's|@''HAVE_CANONICALIZE_FILE_NAME''@|$(HAVE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ + -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ + -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ + -e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMP''@|$(HAVE_MKOSTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \ + -e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \ + -e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \ + -e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \ + -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \ + -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \ + -e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \ + -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \ + -e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \ + -e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \ + -e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \ + -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \ + -e 's|@''HAVE_STRUCT_RANDOM_DATA''@|$(HAVE_STRUCT_RANDOM_DATA)|g' \ + -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ + -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ + -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ + -e 's|@''REPLACE_CALLOC''@|$(REPLACE_CALLOC)|g' \ + -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ + -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ + -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ + -e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \ + -e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \ + -e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \ + -e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \ + -e 's|@''REPLACE_UNSETENV''@|$(REPLACE_UNSETENV)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += stdlib.h stdlib.h-t + +EXTRA_DIST += stdlib.in.h + +## end gnulib module stdlib + ## begin gnulib module strftime === added file 'lib/stdlib.in.h' --- lib/stdlib.in.h 1970-01-01 00:00:00 +0000 +++ lib/stdlib.in.h 2011-02-16 00:33:44 +0000 @@ -0,0 +1,729 @@ +/* A GNU-like . + + Copyright (C) 1995, 2001-2004, 2006-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#if defined __need_malloc_and_calloc +/* Special invocation convention inside glibc header files. */ + +#@INCLUDE_NEXT@ @NEXT_STDLIB_H@ + +#else +/* Normal invocation convention. */ + +#ifndef _GL_STDLIB_H + +/* The include_next requires a split double-inclusion guard. */ +#@INCLUDE_NEXT@ @NEXT_STDLIB_H@ + +#ifndef _GL_STDLIB_H +#define _GL_STDLIB_H + +/* NetBSD 5.0 mis-defines NULL. */ +#include + +/* MirBSD 10 defines WEXITSTATUS in , not in . */ +#if @GNULIB_SYSTEM_POSIX@ && !defined WEXITSTATUS +# include +#endif + +/* Solaris declares getloadavg() in . */ +#if (@GNULIB_GETLOADAVG@ || defined GNULIB_POSIXCHECK) && @HAVE_SYS_LOADAVG_H@ +# include +#endif + +#if @GNULIB_RANDOM_R@ + +/* OSF/1 5.1 declares 'struct random_data' in , which is included + from if _REENTRANT is defined. Include it whenever we need + 'struct random_data'. */ +# if @HAVE_RANDOM_H@ +# include +# endif + +# if !@HAVE_STRUCT_RANDOM_DATA@ || !@HAVE_RANDOM_R@ +# include +# endif + +# if !@HAVE_STRUCT_RANDOM_DATA@ +/* Define 'struct random_data'. + But allow multiple gnulib generated replacements to coexist. */ +# if !GNULIB_defined_struct_random_data +struct random_data +{ + int32_t *fptr; /* Front pointer. */ + int32_t *rptr; /* Rear pointer. */ + int32_t *state; /* Array of state values. */ + int rand_type; /* Type of random number generator. */ + int rand_deg; /* Degree of random number generator. */ + int rand_sep; /* Distance between front and rear. */ + int32_t *end_ptr; /* Pointer behind state table. */ +}; +# define GNULIB_defined_struct_random_data 1 +# endif +# endif +#endif + +#if (@GNULIB_MKSTEMP@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) +/* On MacOS X 10.3, only declares mkstemp. */ +/* On Cygwin 1.7.1, only declares getsubopt. */ +/* But avoid namespace pollution on glibc systems and native Windows. */ +# include +#endif + +#if 3 <= __GNUC__ || __GNUC__ == 2 && 8 <= __GNUC_MINOR__ +# define _GL_ATTRIBUTE_NORETURN __attribute__ ((__noreturn__)) +#else +# define _GL_ATTRIBUTE_NORETURN +#endif + +/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ + +/* The definition of _GL_ARG_NONNULL is copied here. */ + +/* The definition of _GL_WARN_ON_USE is copied here. */ + + +/* Some systems do not define EXIT_*, despite otherwise supporting C89. */ +#ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +#endif +/* Tandem/NSK and other platforms that define EXIT_FAILURE as -1 interfere + with proper operation of xargs. */ +#ifndef EXIT_FAILURE +# define EXIT_FAILURE 1 +#elif EXIT_FAILURE != 1 +# undef EXIT_FAILURE +# define EXIT_FAILURE 1 +#endif + + +#if @GNULIB__EXIT@ +/* Terminate the current process with the given return code, without running + the 'atexit' handlers. */ +# if !@HAVE__EXIT@ +_GL_FUNCDECL_SYS (_Exit, void, (int status) _GL_ATTRIBUTE_NORETURN); +# endif +_GL_CXXALIAS_SYS (_Exit, void, (int status)); +_GL_CXXALIASWARN (_Exit); +#elif defined GNULIB_POSIXCHECK +# undef _Exit +# if HAVE_RAW_DECL__EXIT +_GL_WARN_ON_USE (_Exit, "_Exit is unportable - " + "use gnulib module _Exit for portability"); +# endif +#endif + + +#if @GNULIB_ATOLL@ +/* Parse a signed decimal integer. + Returns the value of the integer. Errors are not detected. */ +# if !@HAVE_ATOLL@ +_GL_FUNCDECL_SYS (atoll, long long, (const char *string) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (atoll, long long, (const char *string)); +_GL_CXXALIASWARN (atoll); +#elif defined GNULIB_POSIXCHECK +# undef atoll +# if HAVE_RAW_DECL_ATOLL +_GL_WARN_ON_USE (atoll, "atoll is unportable - " + "use gnulib module atoll for portability"); +# endif +#endif + +#if @GNULIB_CALLOC_POSIX@ +# if @REPLACE_CALLOC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef calloc +# define calloc rpl_calloc +# endif +_GL_FUNCDECL_RPL (calloc, void *, (size_t nmemb, size_t size)); +_GL_CXXALIAS_RPL (calloc, void *, (size_t nmemb, size_t size)); +# else +_GL_CXXALIAS_SYS (calloc, void *, (size_t nmemb, size_t size)); +# endif +_GL_CXXALIASWARN (calloc); +#elif defined GNULIB_POSIXCHECK +# undef calloc +/* Assume calloc is always declared. */ +_GL_WARN_ON_USE (calloc, "calloc is not POSIX compliant everywhere - " + "use gnulib module calloc-posix for portability"); +#endif + +#if @GNULIB_CANONICALIZE_FILE_NAME@ +# if @REPLACE_CANONICALIZE_FILE_NAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define canonicalize_file_name rpl_canonicalize_file_name +# endif +_GL_FUNCDECL_RPL (canonicalize_file_name, char *, (const char *name) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (canonicalize_file_name, char *, (const char *name)); +# else +# if !@HAVE_CANONICALIZE_FILE_NAME@ +_GL_FUNCDECL_SYS (canonicalize_file_name, char *, (const char *name) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (canonicalize_file_name, char *, (const char *name)); +# endif +_GL_CXXALIASWARN (canonicalize_file_name); +#elif defined GNULIB_POSIXCHECK +# undef canonicalize_file_name +# if HAVE_RAW_DECL_CANONICALIZE_FILE_NAME +_GL_WARN_ON_USE (canonicalize_file_name, + "canonicalize_file_name is unportable - " + "use gnulib module canonicalize-lgpl for portability"); +# endif +#endif + +#if @GNULIB_GETLOADAVG@ +/* Store max(NELEM,3) load average numbers in LOADAVG[]. + The three numbers are the load average of the last 1 minute, the last 5 + minutes, and the last 15 minutes, respectively. + LOADAVG is an array of NELEM numbers. */ +# if !@HAVE_DECL_GETLOADAVG@ +_GL_FUNCDECL_SYS (getloadavg, int, (double loadavg[], int nelem) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (getloadavg, int, (double loadavg[], int nelem)); +_GL_CXXALIASWARN (getloadavg); +#elif defined GNULIB_POSIXCHECK +# undef getloadavg +# if HAVE_RAW_DECL_GETLOADAVG +_GL_WARN_ON_USE (getloadavg, "getloadavg is not portable - " + "use gnulib module getloadavg for portability"); +# endif +#endif + +#if @GNULIB_GETSUBOPT@ +/* Assuming *OPTIONP is a comma separated list of elements of the form + "token" or "token=value", getsubopt parses the first of these elements. + If the first element refers to a "token" that is member of the given + NULL-terminated array of tokens: + - It replaces the comma with a NUL byte, updates *OPTIONP to point past + the first option and the comma, sets *VALUEP to the value of the + element (or NULL if it doesn't contain an "=" sign), + - It returns the index of the "token" in the given array of tokens. + Otherwise it returns -1, and *OPTIONP and *VALUEP are undefined. + For more details see the POSIX:2001 specification. + http://www.opengroup.org/susv3xsh/getsubopt.html */ +# if !@HAVE_GETSUBOPT@ +_GL_FUNCDECL_SYS (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep) + _GL_ARG_NONNULL ((1, 2, 3))); +# endif +_GL_CXXALIAS_SYS (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep)); +_GL_CXXALIASWARN (getsubopt); +#elif defined GNULIB_POSIXCHECK +# undef getsubopt +# if HAVE_RAW_DECL_GETSUBOPT +_GL_WARN_ON_USE (getsubopt, "getsubopt is unportable - " + "use gnulib module getsubopt for portability"); +# endif +#endif + +#if @GNULIB_GRANTPT@ +/* Change the ownership and access permission of the slave side of the + pseudo-terminal whose master side is specified by FD. */ +# if !@HAVE_GRANTPT@ +_GL_FUNCDECL_SYS (grantpt, int, (int fd)); +# endif +_GL_CXXALIAS_SYS (grantpt, int, (int fd)); +_GL_CXXALIASWARN (grantpt); +#elif defined GNULIB_POSIXCHECK +# undef grantpt +# if HAVE_RAW_DECL_GRANTPT +_GL_WARN_ON_USE (ptsname, "grantpt is not portable - " + "use gnulib module grantpt for portability"); +# endif +#endif + +#if @GNULIB_MALLOC_POSIX@ +# if @REPLACE_MALLOC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef malloc +# define malloc rpl_malloc +# endif +_GL_FUNCDECL_RPL (malloc, void *, (size_t size)); +_GL_CXXALIAS_RPL (malloc, void *, (size_t size)); +# else +_GL_CXXALIAS_SYS (malloc, void *, (size_t size)); +# endif +_GL_CXXALIASWARN (malloc); +#elif defined GNULIB_POSIXCHECK +# undef malloc +/* Assume malloc is always declared. */ +_GL_WARN_ON_USE (malloc, "malloc is not POSIX compliant everywhere - " + "use gnulib module malloc-posix for portability"); +#endif + +#if @GNULIB_MKDTEMP@ +/* Create a unique temporary directory from TEMPLATE. + The last six characters of TEMPLATE must be "XXXXXX"; + they are replaced with a string that makes the directory name unique. + Returns TEMPLATE, or a null pointer if it cannot get a unique name. + The directory is created mode 700. */ +# if !@HAVE_MKDTEMP@ +_GL_FUNCDECL_SYS (mkdtemp, char *, (char * /*template*/) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkdtemp, char *, (char * /*template*/)); +_GL_CXXALIASWARN (mkdtemp); +#elif defined GNULIB_POSIXCHECK +# undef mkdtemp +# if HAVE_RAW_DECL_MKDTEMP +_GL_WARN_ON_USE (mkdtemp, "mkdtemp is unportable - " + "use gnulib module mkdtemp for portability"); +# endif +#endif + +#if @GNULIB_MKOSTEMP@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The flags are a bitmask, possibly including O_CLOEXEC (defined in ) + and O_TEXT, O_BINARY (defined in "binary-io.h"). + The file is then created, with the specified flags, ensuring it didn't exist + before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if !@HAVE_MKOSTEMP@ +_GL_FUNCDECL_SYS (mkostemp, int, (char * /*template*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkostemp, int, (char * /*template*/, int /*flags*/)); +_GL_CXXALIASWARN (mkostemp); +#elif defined GNULIB_POSIXCHECK +# undef mkostemp +# if HAVE_RAW_DECL_MKOSTEMP +_GL_WARN_ON_USE (mkostemp, "mkostemp is unportable - " + "use gnulib module mkostemp for portability"); +# endif +#endif + +#if @GNULIB_MKOSTEMPS@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE before a suffix of length + SUFFIXLEN must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The flags are a bitmask, possibly including O_CLOEXEC (defined in ) + and O_TEXT, O_BINARY (defined in "binary-io.h"). + The file is then created, with the specified flags, ensuring it didn't exist + before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if !@HAVE_MKOSTEMPS@ +_GL_FUNCDECL_SYS (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/)); +_GL_CXXALIASWARN (mkostemps); +#elif defined GNULIB_POSIXCHECK +# undef mkostemps +# if HAVE_RAW_DECL_MKOSTEMPS +_GL_WARN_ON_USE (mkostemps, "mkostemps is unportable - " + "use gnulib module mkostemps for portability"); +# endif +#endif + +#if @GNULIB_MKSTEMP@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The file is then created, ensuring it didn't exist before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if @REPLACE_MKSTEMP@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define mkstemp rpl_mkstemp +# endif +_GL_FUNCDECL_RPL (mkstemp, int, (char * /*template*/) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkstemp, int, (char * /*template*/)); +# else +# if ! @HAVE_MKSTEMP@ +_GL_FUNCDECL_SYS (mkstemp, int, (char * /*template*/) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkstemp, int, (char * /*template*/)); +# endif +_GL_CXXALIASWARN (mkstemp); +#elif defined GNULIB_POSIXCHECK +# undef mkstemp +# if HAVE_RAW_DECL_MKSTEMP +_GL_WARN_ON_USE (mkstemp, "mkstemp is unportable - " + "use gnulib module mkstemp for portability"); +# endif +#endif + +#if @GNULIB_MKSTEMPS@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE prior to a suffix of length + SUFFIXLEN must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The file is then created, ensuring it didn't exist before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if !@HAVE_MKSTEMPS@ +_GL_FUNCDECL_SYS (mkstemps, int, (char * /*template*/, int /*suffixlen*/) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkstemps, int, (char * /*template*/, int /*suffixlen*/)); +_GL_CXXALIASWARN (mkstemps); +#elif defined GNULIB_POSIXCHECK +# undef mkstemps +# if HAVE_RAW_DECL_MKSTEMPS +_GL_WARN_ON_USE (mkstemps, "mkstemps is unportable - " + "use gnulib module mkstemps for portability"); +# endif +#endif + +#if @GNULIB_PTSNAME@ +/* Return the pathname of the pseudo-terminal slave associated with + the master FD is open on, or NULL on errors. */ +# if !@HAVE_PTSNAME@ +_GL_FUNCDECL_SYS (ptsname, char *, (int fd)); +# endif +_GL_CXXALIAS_SYS (ptsname, char *, (int fd)); +_GL_CXXALIASWARN (ptsname); +#elif defined GNULIB_POSIXCHECK +# undef ptsname +# if HAVE_RAW_DECL_PTSNAME +_GL_WARN_ON_USE (ptsname, "ptsname is not portable - " + "use gnulib module ptsname for portability"); +# endif +#endif + +#if @GNULIB_PUTENV@ +# if @REPLACE_PUTENV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef putenv +# define putenv rpl_putenv +# endif +_GL_FUNCDECL_RPL (putenv, int, (char *string) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (putenv, int, (char *string)); +# else +_GL_CXXALIAS_SYS (putenv, int, (char *string)); +# endif +_GL_CXXALIASWARN (putenv); +#endif + + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +# ifndef RAND_MAX +# define RAND_MAX 2147483647 +# endif +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (random_r, int, (struct random_data *buf, int32_t *result) + _GL_ARG_NONNULL ((1, 2))); +# endif +_GL_CXXALIAS_SYS (random_r, int, (struct random_data *buf, int32_t *result)); +_GL_CXXALIASWARN (random_r); +#elif defined GNULIB_POSIXCHECK +# undef random_r +# if HAVE_RAW_DECL_RANDOM_R +_GL_WARN_ON_USE (random_r, "random_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (srandom_r, int, + (unsigned int seed, struct random_data *rand_state) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (srandom_r, int, + (unsigned int seed, struct random_data *rand_state)); +_GL_CXXALIASWARN (srandom_r); +#elif defined GNULIB_POSIXCHECK +# undef srandom_r +# if HAVE_RAW_DECL_SRANDOM_R +_GL_WARN_ON_USE (srandom_r, "srandom_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (initstate_r, int, + (unsigned int seed, char *buf, size_t buf_size, + struct random_data *rand_state) + _GL_ARG_NONNULL ((2, 4))); +# endif +_GL_CXXALIAS_SYS (initstate_r, int, + (unsigned int seed, char *buf, size_t buf_size, + struct random_data *rand_state)); +_GL_CXXALIASWARN (initstate_r); +#elif defined GNULIB_POSIXCHECK +# undef initstate_r +# if HAVE_RAW_DECL_INITSTATE_R +_GL_WARN_ON_USE (initstate_r, "initstate_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (setstate_r, int, + (char *arg_state, struct random_data *rand_state) + _GL_ARG_NONNULL ((1, 2))); +# endif +_GL_CXXALIAS_SYS (setstate_r, int, + (char *arg_state, struct random_data *rand_state)); +_GL_CXXALIASWARN (setstate_r); +#elif defined GNULIB_POSIXCHECK +# undef setstate_r +# if HAVE_RAW_DECL_SETSTATE_R +_GL_WARN_ON_USE (setstate_r, "setstate_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + + +#if @GNULIB_REALLOC_POSIX@ +# if @REPLACE_REALLOC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef realloc +# define realloc rpl_realloc +# endif +_GL_FUNCDECL_RPL (realloc, void *, (void *ptr, size_t size)); +_GL_CXXALIAS_RPL (realloc, void *, (void *ptr, size_t size)); +# else +_GL_CXXALIAS_SYS (realloc, void *, (void *ptr, size_t size)); +# endif +_GL_CXXALIASWARN (realloc); +#elif defined GNULIB_POSIXCHECK +# undef realloc +/* Assume realloc is always declared. */ +_GL_WARN_ON_USE (realloc, "realloc is not POSIX compliant everywhere - " + "use gnulib module realloc-posix for portability"); +#endif + +#if @GNULIB_REALPATH@ +# if @REPLACE_REALPATH@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define realpath rpl_realpath +# endif +_GL_FUNCDECL_RPL (realpath, char *, (const char *name, char *resolved) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (realpath, char *, (const char *name, char *resolved)); +# else +# if !@HAVE_REALPATH@ +_GL_FUNCDECL_SYS (realpath, char *, (const char *name, char *resolved) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (realpath, char *, (const char *name, char *resolved)); +# endif +_GL_CXXALIASWARN (realpath); +#elif defined GNULIB_POSIXCHECK +# undef realpath +# if HAVE_RAW_DECL_REALPATH +_GL_WARN_ON_USE (realpath, "realpath is unportable - use gnulib module " + "canonicalize or canonicalize-lgpl for portability"); +# endif +#endif + +#if @GNULIB_RPMATCH@ +/* Test a user response to a question. + Return 1 if it is affirmative, 0 if it is negative, or -1 if not clear. */ +# if !@HAVE_RPMATCH@ +_GL_FUNCDECL_SYS (rpmatch, int, (const char *response) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (rpmatch, int, (const char *response)); +_GL_CXXALIASWARN (rpmatch); +#elif defined GNULIB_POSIXCHECK +# undef rpmatch +# if HAVE_RAW_DECL_RPMATCH +_GL_WARN_ON_USE (rpmatch, "rpmatch is unportable - " + "use gnulib module rpmatch for portability"); +# endif +#endif + +#if @GNULIB_SETENV@ +/* Set NAME to VALUE in the environment. + If REPLACE is nonzero, overwrite an existing value. */ +# if @REPLACE_SETENV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef setenv +# define setenv rpl_setenv +# endif +_GL_FUNCDECL_RPL (setenv, int, + (const char *name, const char *value, int replace) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (setenv, int, + (const char *name, const char *value, int replace)); +# else +# if !@HAVE_DECL_SETENV@ +_GL_FUNCDECL_SYS (setenv, int, + (const char *name, const char *value, int replace) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (setenv, int, + (const char *name, const char *value, int replace)); +# endif +# if !(@REPLACE_SETENV@ && !@HAVE_DECL_SETENV@) +_GL_CXXALIASWARN (setenv); +# endif +#elif defined GNULIB_POSIXCHECK +# undef setenv +# if HAVE_RAW_DECL_SETENV +_GL_WARN_ON_USE (setenv, "setenv is unportable - " + "use gnulib module setenv for portability"); +# endif +#endif + +#if @GNULIB_STRTOD@ + /* Parse a double from STRING, updating ENDP if appropriate. */ +# if @REPLACE_STRTOD@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define strtod rpl_strtod +# endif +_GL_FUNCDECL_RPL (strtod, double, (const char *str, char **endp) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (strtod, double, (const char *str, char **endp)); +# else +# if !@HAVE_STRTOD@ +_GL_FUNCDECL_SYS (strtod, double, (const char *str, char **endp) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (strtod, double, (const char *str, char **endp)); +# endif +_GL_CXXALIASWARN (strtod); +#elif defined GNULIB_POSIXCHECK +# undef strtod +# if HAVE_RAW_DECL_STRTOD +_GL_WARN_ON_USE (strtod, "strtod is unportable - " + "use gnulib module strtod for portability"); +# endif +#endif + +#if @GNULIB_STRTOLL@ +/* Parse a signed integer whose textual representation starts at STRING. + The integer is expected to be in base BASE (2 <= BASE <= 36); if BASE == 0, + it may be decimal or octal (with prefix "0") or hexadecimal (with prefix + "0x"). + If ENDPTR is not NULL, the address of the first byte after the integer is + stored in *ENDPTR. + Upon overflow, the return value is LLONG_MAX or LLONG_MIN, and errno is set + to ERANGE. */ +# if !@HAVE_STRTOLL@ +_GL_FUNCDECL_SYS (strtoll, long long, + (const char *string, char **endptr, int base) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (strtoll, long long, + (const char *string, char **endptr, int base)); +_GL_CXXALIASWARN (strtoll); +#elif defined GNULIB_POSIXCHECK +# undef strtoll +# if HAVE_RAW_DECL_STRTOLL +_GL_WARN_ON_USE (strtoll, "strtoll is unportable - " + "use gnulib module strtoll for portability"); +# endif +#endif + +#if @GNULIB_STRTOULL@ +/* Parse an unsigned integer whose textual representation starts at STRING. + The integer is expected to be in base BASE (2 <= BASE <= 36); if BASE == 0, + it may be decimal or octal (with prefix "0") or hexadecimal (with prefix + "0x"). + If ENDPTR is not NULL, the address of the first byte after the integer is + stored in *ENDPTR. + Upon overflow, the return value is ULLONG_MAX, and errno is set to + ERANGE. */ +# if !@HAVE_STRTOULL@ +_GL_FUNCDECL_SYS (strtoull, unsigned long long, + (const char *string, char **endptr, int base) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (strtoull, unsigned long long, + (const char *string, char **endptr, int base)); +_GL_CXXALIASWARN (strtoull); +#elif defined GNULIB_POSIXCHECK +# undef strtoull +# if HAVE_RAW_DECL_STRTOULL +_GL_WARN_ON_USE (strtoull, "strtoull is unportable - " + "use gnulib module strtoull for portability"); +# endif +#endif + +#if @GNULIB_UNLOCKPT@ +/* Unlock the slave side of the pseudo-terminal whose master side is specified + by FD, so that it can be opened. */ +# if !@HAVE_UNLOCKPT@ +_GL_FUNCDECL_SYS (unlockpt, int, (int fd)); +# endif +_GL_CXXALIAS_SYS (unlockpt, int, (int fd)); +_GL_CXXALIASWARN (unlockpt); +#elif defined GNULIB_POSIXCHECK +# undef unlockpt +# if HAVE_RAW_DECL_UNLOCKPT +_GL_WARN_ON_USE (unlockpt, "unlockpt is not portable - " + "use gnulib module unlockpt for portability"); +# endif +#endif + +#if @GNULIB_UNSETENV@ +/* Remove the variable NAME from the environment. */ +# if @REPLACE_UNSETENV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef unsetenv +# define unsetenv rpl_unsetenv +# endif +_GL_FUNCDECL_RPL (unsetenv, int, (const char *name) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (unsetenv, int, (const char *name)); +# else +# if !@HAVE_DECL_UNSETENV@ +_GL_FUNCDECL_SYS (unsetenv, int, (const char *name) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (unsetenv, int, (const char *name)); +# endif +# if !(@REPLACE_UNSETENV@ && !@HAVE_DECL_UNSETENV@) +_GL_CXXALIASWARN (unsetenv); +# endif +#elif defined GNULIB_POSIXCHECK +# undef unsetenv +# if HAVE_RAW_DECL_UNSETENV +_GL_WARN_ON_USE (unsetenv, "unsetenv is unportable - " + "use gnulib module unsetenv for portability"); +# endif +#endif + + +#endif /* _GL_STDLIB_H */ +#endif /* _GL_STDLIB_H */ +#endif === added file 'm4/getloadavg.m4' --- m4/getloadavg.m4 1970-01-01 00:00:00 +0000 +++ m4/getloadavg.m4 2011-02-16 00:33:44 +0000 @@ -0,0 +1,156 @@ +# Check for getloadavg. + +# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2011 Free Software +# Foundation, Inc. + +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +#serial 2 + +# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. +# New applications should use gl_GETLOADAVG instead. + +# gl_GETLOADAVG(LIBOBJDIR) +# ------------------------ +AC_DEFUN([gl_GETLOADAVG], +[AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) + +# Persuade glibc to declare getloadavg(). +AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + +# Make sure getloadavg.c is where it belongs, at configure-time. +test -f "$srcdir/$1/getloadavg.c" || + AC_MSG_ERROR([$srcdir/$1/getloadavg.c is missing]) + +gl_save_LIBS=$LIBS + +AC_CHECK_FUNC([getloadavg], [], + [gl_have_func=no + + # Some systems with -lutil have (and need) -lkvm as well, some do not. + # On Solaris, -lkvm requires nlist from -lelf, so check that first + # to get the right answer into the cache. + # For kstat on solaris, we need to test for libelf and libkvm to force the + # definition of SVR4 below. + if test $gl_have_func = no; then + AC_CHECK_LIB([elf], [elf_begin], [LIBS="-lelf $LIBS"]) + AC_CHECK_LIB([kvm], [kvm_open], [LIBS="-lkvm $LIBS"]) + # Check for the 4.4BSD definition of getloadavg. + AC_CHECK_LIB([util], [getloadavg], + [LIBS="-lutil $LIBS" gl_have_func=yes]) + fi + + if test $gl_have_func = no; then + # There is a commonly available library for RS/6000 AIX. + # Since it is not a standard part of AIX, it might be installed locally. + gl_getloadavg_LIBS=$LIBS + LIBS="-L/usr/local/lib $LIBS" + AC_CHECK_LIB([getloadavg], [getloadavg], + [LIBS="-lgetloadavg $LIBS" gl_have_func=yes], + [LIBS=$gl_getloadavg_LIBS]) + fi + + # Set up the replacement function if necessary. + if test $gl_have_func = no; then + AC_LIBOBJ([getloadavg]) + gl_PREREQ_GETLOADAVG + fi]) + +if test "x$gl_save_LIBS" = x; then + GETLOADAVG_LIBS=$LIBS +else + GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` +fi +LIBS=$gl_save_LIBS + +AC_SUBST([GETLOADAVG_LIBS])dnl + +# Test whether the system declares getloadavg. Solaris has the function +# but declares it in , not . +AC_CHECK_HEADERS([sys/loadavg.h]) +if test $ac_cv_header_sys_loadavg_h = yes; then + HAVE_SYS_LOADAVG_H=1 +else + HAVE_SYS_LOADAVG_H=0 +fi +AC_CHECK_DECL([getloadavg], [], [HAVE_DECL_GETLOADAVG=0], + [#if HAVE_SYS_LOADAVG_H + # include + #endif + #include ]) +])# gl_GETLOADAVG + + +# gl_PREREQ_GETLOADAVG +# -------------------- +# Set up the AC_LIBOBJ replacement of `getloadavg'. +AC_DEFUN([gl_PREREQ_GETLOADAVG], +[ +# Figure out what our getloadavg.c needs. + +# Solaris has libkstat which does not require root. +AC_CHECK_LIB([kstat], [kstat_open]) +test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes + +# On HPUX9, an unprivileged user can get load averages this way. +if test $gl_have_func = no; then + AC_CHECK_FUNCS([pstat_getdynamic], [gl_have_func=yes]) +fi + +# AIX has libperfstat which does not require root +if test $gl_have_func = no; then + AC_CHECK_LIB([perfstat], [perfstat_cpu_total]) + test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADER([sys/dg_sys_info.h], + [gl_have_func=yes + AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with .]) + AC_CHECK_LIB([dgc], [dg_sys_info])]) +fi + +# We cannot check for , because Solaris 2 does not use dwarf (it +# uses stabs), but it is still SVR4. We cannot check for because +# Irix 4.0.5F has the header but not the library. +if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ + && test "$ac_cv_lib_kvm_kvm_open" = yes; then + gl_have_func=yes + AC_DEFINE([SVR4], [1], [Define to 1 on System V Release 4.]) +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADER([inq_stats/cpustats.h], + [gl_have_func=yes + AC_DEFINE([UMAX], [1], [Define to 1 for Encore UMAX.]) + AC_DEFINE([UMAX4_3], [1], + [Define to 1 for Encore UMAX 4.3 that has + instead of .])]) +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADER([sys/cpustats.h], + [gl_have_func=yes; AC_DEFINE([UMAX])]) +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADERS([mach/mach.h]) +fi + +AC_CHECK_HEADERS([nlist.h], +[AC_CHECK_MEMBERS([struct nlist.n_un.n_name], + [], [], + [@%:@include ]) + AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], + [[struct nlist x; + #ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME + x.n_un.n_name = ""; + #else + x.n_name = ""; + #endif]])], + [AC_DEFINE([N_NAME_POINTER], [1], + [Define to 1 if the nlist n_name member is a pointer])]) +])dnl +])# gl_PREREQ_GETLOADAVG === modified file 'm4/gl-comp.m4' --- m4/gl-comp.m4 2011-02-03 19:29:35 +0000 +++ m4/gl-comp.m4 2011-02-16 00:33:44 +0000 @@ -31,6 +31,7 @@ # Code from module dtoastr: # Code from module extensions: AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + # Code from module getloadavg: # Code from module getopt-gnu: # Code from module getopt-posix: # Code from module gettext-h: @@ -41,6 +42,7 @@ # Code from module multiarch: # Code from module stdbool: # Code from module stddef: + # Code from module stdlib: # Code from module strftime: # Code from module time: # Code from module time_r: @@ -69,6 +71,9 @@ # Code from module dtoastr: AC_REQUIRE([gl_C99_STRTOLD]) # Code from module extensions: + # Code from module getloadavg: + gl_GETLOADAVG([$gl_source_base]) + gl_STDLIB_MODULE_INDICATOR([getloadavg]) # Code from module getopt-gnu: gl_FUNC_GETOPT_GNU gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu]) @@ -90,6 +95,8 @@ AM_STDBOOL_H # Code from module stddef: gl_STDDEF_H + # Code from module stdlib: + gl_STDLIB_H # Code from module strftime: gl_FUNC_GNU_STRFTIME # Code from module time: @@ -246,6 +253,7 @@ lib/dtoastr.c lib/ftoastr.c lib/ftoastr.h + lib/getloadavg.c lib/getopt.c lib/getopt.in.h lib/getopt1.c @@ -257,6 +265,7 @@ lib/mktime.c lib/stdbool.in.h lib/stddef.in.h + lib/stdlib.in.h lib/strftime.c lib/strftime.h lib/time.in.h @@ -265,6 +274,7 @@ m4/00gnulib.m4 m4/c-strtod.m4 m4/extensions.m4 + m4/getloadavg.m4 m4/getopt.m4 m4/gnulib-common.m4 m4/include_next.m4 @@ -272,6 +282,7 @@ m4/multiarch.m4 m4/stdbool.m4 m4/stddef_h.m4 + m4/stdlib_h.m4 m4/strftime.m4 m4/time_h.m4 m4/time_r.m4 === added file 'm4/stdlib_h.m4' --- m4/stdlib_h.m4 1970-01-01 00:00:00 +0000 +++ m4/stdlib_h.m4 2011-02-16 00:33:44 +0000 @@ -0,0 +1,101 @@ +# stdlib_h.m4 serial 36 +dnl Copyright (C) 2007-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_STDLIB_H], +[ + AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) + gl_NEXT_HEADERS([stdlib.h]) + + dnl Check for declarations of anything we want to poison if the + dnl corresponding gnulib module is not in use, and which is not + dnl guaranteed by C89. + gl_WARN_ON_USE_PREPARE([[#include +#if HAVE_SYS_LOADAVG_H +# include +#endif +#if HAVE_RANDOM_H +# include +#endif + ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt mkdtemp + mkostemp mkostemps mkstemp mkstemps ptsname random_r initstat_r srandom_r + setstate_r realpath rpmatch setenv strtod strtoll strtoull unlockpt + unsetenv]) +]) + +AC_DEFUN([gl_STDLIB_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) + gl_MODULE_INDICATOR_SET_VARIABLE([$1]) + dnl Define it also as a C macro, for the benefit of the unit tests. + gl_MODULE_INDICATOR_FOR_TESTS([$1]) +]) + +AC_DEFUN([gl_STDLIB_H_DEFAULTS], +[ + GNULIB__EXIT=0; AC_SUBST([GNULIB__EXIT]) + GNULIB_ATOLL=0; AC_SUBST([GNULIB_ATOLL]) + GNULIB_CALLOC_POSIX=0; AC_SUBST([GNULIB_CALLOC_POSIX]) + GNULIB_CANONICALIZE_FILE_NAME=0; AC_SUBST([GNULIB_CANONICALIZE_FILE_NAME]) + GNULIB_GETLOADAVG=0; AC_SUBST([GNULIB_GETLOADAVG]) + GNULIB_GETSUBOPT=0; AC_SUBST([GNULIB_GETSUBOPT]) + GNULIB_GRANTPT=0; AC_SUBST([GNULIB_GRANTPT]) + GNULIB_MALLOC_POSIX=0; AC_SUBST([GNULIB_MALLOC_POSIX]) + GNULIB_MKDTEMP=0; AC_SUBST([GNULIB_MKDTEMP]) + GNULIB_MKOSTEMP=0; AC_SUBST([GNULIB_MKOSTEMP]) + GNULIB_MKOSTEMPS=0; AC_SUBST([GNULIB_MKOSTEMPS]) + GNULIB_MKSTEMP=0; AC_SUBST([GNULIB_MKSTEMP]) + GNULIB_MKSTEMPS=0; AC_SUBST([GNULIB_MKSTEMPS]) + GNULIB_PTSNAME=0; AC_SUBST([GNULIB_PTSNAME]) + GNULIB_PUTENV=0; AC_SUBST([GNULIB_PUTENV]) + GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R]) + GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX]) + GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH]) + GNULIB_RPMATCH=0; AC_SUBST([GNULIB_RPMATCH]) + GNULIB_SETENV=0; AC_SUBST([GNULIB_SETENV]) + GNULIB_STRTOD=0; AC_SUBST([GNULIB_STRTOD]) + GNULIB_STRTOLL=0; AC_SUBST([GNULIB_STRTOLL]) + GNULIB_STRTOULL=0; AC_SUBST([GNULIB_STRTOULL]) + GNULIB_SYSTEM_POSIX=0; AC_SUBST([GNULIB_SYSTEM_POSIX]) + GNULIB_UNLOCKPT=0; AC_SUBST([GNULIB_UNLOCKPT]) + GNULIB_UNSETENV=0; AC_SUBST([GNULIB_UNSETENV]) + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE__EXIT=1; AC_SUBST([HAVE__EXIT]) + HAVE_ATOLL=1; AC_SUBST([HAVE_ATOLL]) + HAVE_CANONICALIZE_FILE_NAME=1; AC_SUBST([HAVE_CANONICALIZE_FILE_NAME]) + HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG]) + HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT]) + HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT]) + HAVE_MKDTEMP=1; AC_SUBST([HAVE_MKDTEMP]) + HAVE_MKOSTEMP=1; AC_SUBST([HAVE_MKOSTEMP]) + HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS]) + HAVE_MKSTEMP=1; AC_SUBST([HAVE_MKSTEMP]) + HAVE_MKSTEMPS=1; AC_SUBST([HAVE_MKSTEMPS]) + HAVE_PTSNAME=1; AC_SUBST([HAVE_PTSNAME]) + HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H]) + HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R]) + HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH]) + HAVE_RPMATCH=1; AC_SUBST([HAVE_RPMATCH]) + HAVE_SETENV=1; AC_SUBST([HAVE_SETENV]) + HAVE_DECL_SETENV=1; AC_SUBST([HAVE_DECL_SETENV]) + HAVE_STRTOD=1; AC_SUBST([HAVE_STRTOD]) + HAVE_STRTOLL=1; AC_SUBST([HAVE_STRTOLL]) + HAVE_STRTOULL=1; AC_SUBST([HAVE_STRTOULL]) + HAVE_STRUCT_RANDOM_DATA=1; AC_SUBST([HAVE_STRUCT_RANDOM_DATA]) + HAVE_SYS_LOADAVG_H=0; AC_SUBST([HAVE_SYS_LOADAVG_H]) + HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT]) + HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV]) + REPLACE_CALLOC=0; AC_SUBST([REPLACE_CALLOC]) + REPLACE_CANONICALIZE_FILE_NAME=0; AC_SUBST([REPLACE_CANONICALIZE_FILE_NAME]) + REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC]) + REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP]) + REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) + REPLACE_REALLOC=0; AC_SUBST([REPLACE_REALLOC]) + REPLACE_REALPATH=0; AC_SUBST([REPLACE_REALPATH]) + REPLACE_SETENV=0; AC_SUBST([REPLACE_SETENV]) + REPLACE_STRTOD=0; AC_SUBST([REPLACE_STRTOD]) + REPLACE_UNSETENV=0; AC_SUBST([REPLACE_UNSETENV]) +]) === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-15 03:57:00 +0000 +++ src/ChangeLog 2011-02-16 00:33:44 +0000 @@ -1,3 +1,29 @@ +2011-02-16 Paul Eggert + + Remove no-longer needed getloadavg symbols. + * m/alpha.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/amdx86-64.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/ia64.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/ibms390.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/macppc.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/sparc.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/template.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/vax.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * s/aix4-2.h (KERNEL_FILE, LDAV_SYMBOL): Remove. + * s/bsd-common.h (KERNEL_FILE, LDAV_SYMBOL): Remove #undef. + * s/hpux10-20.h (KERNEL_FILE, LOAD_AVE_TYPE, LOAD_AVE_CVT): + (LDAV_SYMBOL): Remove. + * s/unixware.h (LOAD_AVE_TYPE, LOAD_AVE_CVT, FSCALE): Remove. + * s/usg5-4-common.h (KERNEL_FILE, LDAV_SYMBOL): Remove. + + Import getloadavg module from gnulib. + * deps.mk (getloadavg.o): Remove; gnulib now does this. + * lisp.h (getloadavg) [!defined HAVE_GETLOADAVG]: Remove; gnulib + now does this. + * src/s/freebsd.h (HAVE_GETLOADAVG): Remove; gnulib now does this. + * src/s/netbsd.h (HAVE_GETLOADAVG): Likewise. + * config.in: Regenerate. + 2011-02-15 Eli Zaretskii * nsfns.m (ns_set_name_as_filename, Fns_read_file_name): Use B_. @@ -9,7 +35,7 @@ 2011-02-14 Eli Zaretskii - * msdos.c (IT_frame_up_to_date): + * msdos.c (IT_frame_up_to_date): * s/msdos.h (MODE_LINE_BINARY_TEXT): Use B_ for the MS-DOS build. * dired.c (directory_files_internal): === modified file 'src/config.in' --- src/config.in 2011-02-05 05:07:22 +0000 +++ src/config.in 2011-02-16 00:33:44 +0000 @@ -42,9 +42,6 @@ /* Define to 1 if using `alloca.c'. */ #undef C_ALLOCA -/* Define to 1 if using `getloadavg.c'. */ -#undef C_GETLOADAVG - /* Define to 1 for DGUX with . */ #undef DGUX @@ -74,10 +71,6 @@ /* Define this to check for short string overrun. */ #undef GC_CHECK_STRING_OVERRUN -/* Define to 1 if the `getloadavg' function needs to be run setuid or setgid. - */ -#undef GETLOADAVG_PRIVILEGED - /* Define to 1 if the `getpgrp' function requires zero arguments. */ #undef GETPGRP_VOID @@ -225,9 +218,6 @@ /* Define to 1 if you have the `getline' function. */ #undef HAVE_GETLINE -/* Define to 1 if you have the `getloadavg' function. */ -#undef HAVE_GETLOADAVG - /* Define to 1 if you have the header file. */ #undef HAVE_GETOPT_H @@ -408,6 +398,9 @@ /* Define to 1 if using libotf. */ #undef HAVE_LIBOTF +/* Define to 1 if you have the `perfstat' library (-lperfstat). */ +#undef HAVE_LIBPERFSTAT + /* Define to 1 if you have the header file. */ #undef HAVE_LIBPNG_PNG_H @@ -672,6 +665,9 @@ /* Define to 1 if you have the `sysinfo' function. */ #undef HAVE_SYSINFO +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_LOADAVG_H + /* Define to 1 if you have the header file. */ #undef HAVE_SYS_MMAN_H @@ -870,10 +866,6 @@ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP -/* Define to 1 if your `struct nlist' has an `n_un' member. Obsolete, depend - on `HAVE_STRUCT_NLIST_N_UN_N_NAME */ -#undef NLIST_NAME_UNION - /* Define to 1 if you don't have struct exception in math.h. */ #undef NO_MATHERR @@ -889,6 +881,9 @@ /* Define to 1 if you are using NS windowing under GNUstep. */ #undef NS_IMPL_GNUSTEP +/* Define to 1 if the nlist n_name member is a pointer */ +#undef N_NAME_POINTER + /* Define if the C compiler is the linker. */ #undef ORDINARY_LINK === modified file 'src/deps.mk' --- src/deps.mk 2011-02-04 12:01:34 +0000 +++ src/deps.mk 2011-02-16 00:33:44 +0000 @@ -115,7 +115,6 @@ ftfont.o: ftfont.c dispextern.h frame.h character.h charset.h composite.h \ font.h lisp.h $(config_h) blockinput.h atimer.h systime.h coding.h \ fontset.h ccl.h ftfont.h globals.h -getloadavg.o: getloadavg.c $(config_h) gnutls.o: gnutls.c gnutls.h process.h ../lib/unistd.h \ lisp.h globals.h $(config_h) gtkutil.o: gtkutil.c gtkutil.h xterm.h lisp.h frame.h lisp.h $(config_h) \ === modified file 'src/lisp.h' --- src/lisp.h 2011-02-14 15:39:19 +0000 +++ src/lisp.h 2011-02-16 00:33:44 +0000 @@ -3407,11 +3407,6 @@ EXFUN (Fx_load_color_file, 1); extern void syms_of_xfaces (void); -#ifndef HAVE_GETLOADAVG -/* Defined in getloadavg.c */ -extern int getloadavg (double *, int); -#endif - #ifdef HAVE_X_WINDOWS /* Defined in xfns.c */ extern void syms_of_xfns (void); === modified file 'src/m/alpha.h' --- src/m/alpha.h 2011-01-25 04:08:28 +0000 +++ src/m/alpha.h 2011-02-16 00:33:44 +0000 @@ -29,12 +29,6 @@ /* __alpha defined automatically */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef __ELF__ #if !defined(GNU_LINUX) && !defined(__NetBSD__) @@ -57,4 +51,3 @@ Define DBL_MIN_REPLACEMENT to be the next value larger than DBL_MIN: this avoids the assembler bug. */ #define DBL_MIN_REPLACEMENT 2.2250738585072019e-308 - === modified file 'src/m/amdx86-64.h' --- src/m/amdx86-64.h 2011-01-25 04:08:28 +0000 +++ src/m/amdx86-64.h 2011-02-16 00:33:44 +0000 @@ -30,12 +30,5 @@ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - /* Define XPNTR to avoid or'ing with DATA_SEG_BITS */ #undef DATA_SEG_BITS - === modified file 'src/m/ia64.h' --- src/m/ia64.h 2011-01-25 04:08:28 +0000 +++ src/m/ia64.h 2011-02-16 00:33:44 +0000 @@ -30,12 +30,6 @@ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef REL_ALLOC #ifndef _MALLOC_INTERNAL /* "char *" because ralloc.c defines it that way. gmalloc.c thinks it @@ -45,4 +39,3 @@ extern void r_alloc_free (); #endif /* not _MALLOC_INTERNAL */ #endif /* REL_ALLOC */ - === modified file 'src/m/ibms390.h' --- src/m/ibms390.h 2011-01-25 04:08:28 +0000 +++ src/m/ibms390.h 2011-02-16 00:33:44 +0000 @@ -18,12 +18,6 @@ along with GNU Emacs. If not, see . */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - /* Define VIRT_ADDR_VARIES if the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. @@ -31,4 +25,3 @@ Otherwise Emacs assumes that text space precedes data space, numerically. */ #define VIRT_ADDR_VARIES - === modified file 'src/m/macppc.h' --- src/m/macppc.h 2011-01-25 04:08:28 +0000 +++ src/m/macppc.h 2011-02-16 00:33:44 +0000 @@ -17,15 +17,8 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef _ARCH_PPC64 #ifndef _LP64 #define _LP64 #endif #endif - === modified file 'src/m/sparc.h' --- src/m/sparc.h 2011-01-25 04:08:28 +0000 +++ src/m/sparc.h 2011-02-16 00:33:44 +0000 @@ -19,12 +19,6 @@ /* __sparc__ is defined by the compiler by default. */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef __arch64__ /* GCC, 64-bit ABI. */ #define BITS_PER_LONG 64 @@ -34,4 +28,3 @@ #endif #endif /* __arch64__ */ - === modified file 'src/m/template.h' --- src/m/template.h 2011-01-25 04:08:28 +0000 +++ src/m/template.h 2011-02-16 00:33:44 +0000 @@ -21,12 +21,6 @@ does not define it automatically. Ones defined so far include m68k and many others */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - /* Define VIRT_ADDR_VARIES if the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. @@ -46,4 +40,3 @@ If you've just fixed a problem in an existing configuration file, you should also check `etc/MACHINES' to make sure its descriptions of known problems in that configuration should be updated. */ - === modified file 'src/m/vax.h' --- src/m/vax.h 2011-01-25 04:08:28 +0000 +++ src/m/vax.h 2011-02-16 00:33:44 +0000 @@ -20,14 +20,4 @@ /* #define vax -- appears to be done automatically */ -/* USG systems I know of running on Vaxes do not actually - support the load average, so disable it for them. */ - -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE double - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) - #define HAVE_FTIME - === modified file 'src/s/aix4-2.h' --- src/s/aix4-2.h 2011-01-25 04:08:28 +0000 +++ src/s/aix4-2.h 2011-02-16 00:33:44 +0000 @@ -41,12 +41,6 @@ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS - -/* The file containing the kernel's symbol table is called /unix. */ -#define KERNEL_FILE "/unix" - -/* The kernel symbol where the load average is found is named avenrun. */ -#define LDAV_SYMBOL "avenrun" /* Special items needed to make Emacs run on this system. */ @@ -86,4 +80,3 @@ Emacs currently calls xrealloc on the results of get_current_dir name, to avoid a crash just use the Emacs implementation for that function. */ #define BROKEN_GET_CURRENT_DIR_NAME 1 - === modified file 'src/s/bsd-common.h' --- src/s/bsd-common.h 2011-01-25 04:08:28 +0000 +++ src/s/bsd-common.h 2011-02-16 00:33:44 +0000 @@ -37,10 +37,6 @@ #define TABDLY OXTABS #define TAB3 OXTABS -/* These aren't needed, since we have getloadavg. */ -#undef KERNEL_FILE -#undef LDAV_SYMBOL - #define NO_TERMIO /* If the system's imake configuration file defines `NeedWidePrototypes' @@ -72,12 +68,5 @@ a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION -/* The file containing the kernel's symbol table is called /vmunix. */ -#define KERNEL_FILE "/vmunix" - -/* The kernel symbol where the load average is found is named _avenrun. */ -#define LDAV_SYMBOL "_avenrun" - /* Send signals to subprocesses by "typing" special chars at them. */ #define SIGNALS_VIA_CHARACTERS - === modified file 'src/s/freebsd.h' --- src/s/freebsd.h 2011-01-25 04:08:28 +0000 +++ src/s/freebsd.h 2011-02-16 00:33:44 +0000 @@ -25,8 +25,6 @@ #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) -#define HAVE_GETLOADAVG 1 - /* This silences a few compilation warnings. */ #undef BSD_SYSTEM #if __FreeBSD__ == 1 === modified file 'src/s/hpux10-20.h' --- src/s/hpux10-20.h 2011-01-25 04:08:28 +0000 +++ src/s/hpux10-20.h 2011-02-16 00:33:44 +0000 @@ -47,9 +47,6 @@ a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION -/* The symbol in the kernel where the load average is found - depends on the cpu type, so we let the m- files define LDAV_SYMBOL. */ - /* Special hacks needed to make Emacs run on this system. */ /* In hpux, the symbol SIGIO is defined, but the feature @@ -91,9 +88,6 @@ #undef random #undef HAVE_RANDOM -/* AlainF 20-Jul-1996 says this is right. */ -#define KERNEL_FILE "/stand/vmunix" - /* Rainer Malzbender says definining HAVE_XRMSETDATABASE allows Emacs to compile on HP-UX 10.20 using GCC. */ @@ -119,18 +113,3 @@ #define DATA_SEG_BITS 0x40000000 #define DATA_START 0x40000000 - -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE double - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) ((int) (x * 100.0)) - -/* The kernel symbol where the load average is found is named _avenrun. - At this time there are two major flavors of hp-ux (there is the s800 - and s300 (s200) flavors). The differences are thusly moved to the - corresponding machine description file. */ - -/* No underscore please. */ -#define LDAV_SYMBOL "avenrun" - === modified file 'src/s/netbsd.h' --- src/s/netbsd.h 2011-01-25 04:08:28 +0000 +++ src/s/netbsd.h 2011-02-16 00:33:44 +0000 @@ -21,8 +21,6 @@ /* Get most of the stuff from bsd-common. */ #include "bsd-common.h" -#define HAVE_GETLOADAVG 1 - #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) #define DEFAULT_SOUND_DEVICE "/dev/audio" @@ -43,4 +41,3 @@ /* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method. */ #define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS - === modified file 'src/s/unixware.h' --- src/s/unixware.h 2011-01-25 04:08:28 +0000 +++ src/s/unixware.h 2011-02-16 00:33:44 +0000 @@ -49,14 +49,4 @@ pty_name[sizeof(pty_name) - 1] = 0; \ } -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -/* This is totally uncalibrated. */ -#define LOAD_AVE_CVT(x) ((int) (((double) (x)) * 100.0 / FSCALE)) -#define FSCALE 256.0 - - #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base) - === modified file 'src/s/usg5-4-common.h' --- src/s/usg5-4-common.h 2011-01-25 04:08:28 +0000 +++ src/s/usg5-4-common.h 2011-02-16 00:33:44 +0000 @@ -30,12 +30,6 @@ It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" -/* The file containing the kernel's symbol table is called /unix. */ -#define KERNEL_FILE "/unix" - -/* The kernel symbol where the load average is found is named avenrun. */ -#define LDAV_SYMBOL "avenrun" - /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp @@ -105,4 +99,3 @@ /* This definition was suggested for next release. So give it a try. */ #define HAVE_SOCKETS - ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.