Mercurial > emacs
changeset 91304:c938ab6810a4
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-308
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Wed, 02 Jan 2008 04:13:39 +0000 |
| parents | 1ae1f4066439 (current diff) f5ab33e0dc01 (diff) |
| children | b919d16b3066 |
| files | etc/NEWS lisp/ChangeLog lisp/calc/calc-lang.el lisp/calc/calc-units.el lisp/cus-edit.el lisp/cus-face.el lisp/custom.el lisp/emacs-lisp/elp.el lisp/facemenu.el lisp/faces.el lisp/files.el lisp/font-lock.el lisp/man.el lisp/net/rcirc.el lisp/startup.el lisp/textmodes/ispell.el lisp/thumbs.el lisp/vc-bzr.el lisp/vc-cvs.el lisp/vc-hooks.el lisp/vc-svn.el lisp/vc.el src/ChangeLog src/textprop.c src/w32fns.c |
| diffstat | 36 files changed, 1224 insertions(+), 455 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/emacs/ChangeLog Sat Dec 29 02:51:57 2007 +0000 +++ b/doc/emacs/ChangeLog Wed Jan 02 04:13:39 2008 +0000 @@ -1,3 +1,7 @@ +2007-12-31 Martin Rudalics <rudalics@gmx.at> + + * glossary.texi (Glossary): Fix typo. + 2007-12-27 Richard Stallman <rms@gnu.org> * text.texi (Formatted Text): Improve menu tag. @@ -12,7 +16,7 @@ * search.texi (Query Replace): Make exp of query-replace more self-contained, and clarify. - + * cc-mode.texi (Getting Started): Change @ref to @pxref. 2007-12-15 Richard Stallman <rms@gnu.org>
--- a/doc/emacs/glossary.texi Sat Dec 29 02:51:57 2007 +0000 +++ b/doc/emacs/glossary.texi Wed Jan 02 04:13:39 2008 +0000 @@ -1082,7 +1082,7 @@ @xref{Frames}. @item Selected Window -The selected frame is the one your input currently operates on. +The selected window is the one your input currently operates on. @xref{Basic Window}. @item Selecting a Buffer
--- a/doc/lispref/ChangeLog Sat Dec 29 02:51:57 2007 +0000 +++ b/doc/lispref/ChangeLog Wed Jan 02 04:13:39 2008 +0000 @@ -1,3 +1,8 @@ +2007-12-30 Richard Stallman <rms@gnu.org> + + * commands.texi (Accessing Mouse): Renamed from Accessing Events. + (Accessing Scroll): New node broken out of Accessing Mouse. + 2007-12-28 Richard Stallman <rms@gnu.org> * frames.texi (Size Parameters): Fix typo.
--- a/doc/lispref/commands.texi Sat Dec 29 02:51:57 2007 +0000 +++ b/doc/lispref/commands.texi Wed Jan 02 04:13:39 2008 +0000 @@ -954,7 +954,8 @@ * Event Examples:: Examples of the lists for mouse events. * Classifying Events:: Finding the modifier keys in an event symbol. Event types. -* Accessing Events:: Functions to extract info from events. +* Accessing Mouse:: Functions to extract info from mouse events. +* Accessing Scroll:: Functions to get info from scroll bar events. * Strings of Events:: Special considerations for putting keyboard character events in a string. @end menu @@ -1810,8 +1811,8 @@ @end example @end defun -@node Accessing Events -@subsection Accessing Events +@node Accessing Mouse +@subsection Accessing Mouse Events @cindex mouse events, data in This section describes convenient functions for accessing the data in @@ -1957,6 +1958,10 @@ the entire window area including scroll bars, margins and fringes. @end defun +@node Accessing Scroll +@subsection Accessing Scroll Bar Events +@cindex scroll bar events, data in + These functions are useful for decoding scroll bar events. @defun scroll-bar-event-ratio event
--- a/doc/misc/ChangeLog Sat Dec 29 02:51:57 2007 +0000 +++ b/doc/misc/ChangeLog Wed Jan 02 04:13:39 2008 +0000 @@ -1,3 +1,12 @@ +2007-12-30 Michael Albinus <michael.albinus@gmx.de> + + * dbus.texi (all): Replace "..." by @dots{}. + (Type Conversion): Precise the value range for :byte types. + (Signals): Rename dbus-unregister-signal to dbus-unregister-object. + Mention its return value. + (Errors and Events): There is no D-Bus error propagation during event + processing. + 2007-12-29 Jay Belanger <jay.p.belanger@gmail.com> * calc.tex (Yacas Language, Maxima Language, Giac Language):
--- a/doc/misc/dbus.texi Sat Dec 29 02:51:57 2007 +0000 +++ b/doc/misc/dbus.texi Wed Jan 02 04:13:39 2008 +0000 @@ -197,13 +197,13 @@ <method name=\"GetAllProperties\"> <arg name=\"properties\" direction=\"out\" type=\"a@{sv@}\"/> </method> - ... + @dots{} <signal name=\"PropertyModified\"> <arg name=\"num_updates\" type=\"i\"/> <arg name=\"updates\" type=\"a(sbb)\"/> </signal> </interface> - ... + @dots{} </node>" @end example @@ -277,21 +277,27 @@ Example: @lisp -(dbus-call-method ... @var{NUMBER} @var{STRING}) +(dbus-call-method @dots{} @var{NUMBER} @var{STRING}) @end lisp is equivalent to @lisp -(dbus-call-method ... :uint32 @var{NUMBER} :string @var{STRING}) +(dbus-call-method @dots{} :uint32 @var{NUMBER} :string @var{STRING}) @end lisp but different to @lisp -(dbus-call-method ... :int32 @var{NUMBER} :signature @var{STRING}) +(dbus-call-method @dots{} :int32 @var{NUMBER} :signature @var{STRING}) @end lisp +The value for a byte type can be any integer in the range 0 through +255. If a character is used as argument, modifiers represented +outside this range are stripped of. For example, @code{:byte ?x} is +equal to @code{:byte ?\M-x}, but it is not equal to @code{:byte +?\C-x} or @code{:byte ?\M-\C-x}. + A D-Bus compound type is always represented as list. The car of this list can be the type symbol @code{:array}, @code{:variant}, @code{:struct} or @code{:dict-entry}, which would result in a @@ -313,7 +319,7 @@ Example: @lisp -(dbus-send-signal ... +(dbus-send-signal @dots{} :object-path STRING '(:variant :boolean BOOL) '(:array NUMBER NUMBER) '(:array BOOL :boolean BOOL) '(:struct BOOL :boolean BOOL BOOL @@ -365,7 +371,7 @@ (@var{BOOL} stands here for either @code{nil} or @code{t}): @lisp -(@var{NUMBER} ((@var{STRING} @var{BOOL} @var{BOOL}) (@var{STRING} @var{BOOL} @var{BOOL}) ...)) +(@var{NUMBER} ((@var{STRING} @var{BOOL} @var{BOOL}) (@var{STRING} @var{BOOL} @var{BOOL}) @dots{})) @end lisp @@ -460,7 +466,7 @@ system.chassis.manufacturer = \"COMPAL\" system.chassis.type = \"Notebook\" system.firmware.release_date = \"03/19/2005\" - ..." + @dots{}" @end example @end defun @@ -548,13 +554,15 @@ which objects the GNU/Linux @code{hal} daemon adds. @code{dbus-register-signal} returns a Lisp symbol, which can be used -as argument in @code{dbus-unregister-signal} for removing the +as argument in @code{dbus-unregister-object} for removing the registration for @var{signal}. @end defun -@defun dbus-unregister-signal object +@defun dbus-unregister-object object Unregister @var{object} from the the D-Bus. @var{object} must be the -result of a preceding @code{dbus-register-signal} call. +result of a preceding @code{dbus-register-signal} or +@code{dbus-register-method} call. It returns @code{t} if @var{object} +has been unregistered, @code{nil} otherwise. @end defun @@ -624,6 +632,10 @@ from. It is either a signal name or a method name. @end defun +D-Bus errors are not propagated during event handling, because it is +usually not desired. D-Bus errors in events can be made visible by +setting the variable @code{dbus-debug} to @code{t}. + @node GNU Free Documentation License @appendix GNU Free Documentation License
--- a/etc/NEWS Sat Dec 29 02:51:57 2007 +0000 +++ b/etc/NEWS Wed Jan 02 04:13:39 2008 +0000 @@ -470,6 +470,9 @@ ** The new function `read-color' reads a color name using the minibuffer. +** The new function `face-all-attributes' returns an alist +describing all the basic attributes of a given face. + ** `interprogram-paste-function' can now return one string or a list of strings. In the latter case, Emacs puts the second and following strings on the kill ring.
--- a/lisp/ChangeLog Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/ChangeLog Wed Jan 02 04:13:39 2008 +0000 @@ -1,3 +1,152 @@ +2008-01-02 Miles Bader <Miles Bader <miles@gnu.org>> + + * net/rcirc.el (rcirc-log-filename-function): New variable. + (rcirc-log): Use `rcirc-log-filename-function' to generate the + log-file name. Don't log anything if it returns nil. + (rcirc-log-write): Use `expand-file-name' when merging the + log-file name from the alist with rcirc-log-directory; this does + the right thing if the name in the alist already an absolute + filename. Make the log-file directory if necessary. + +2007-12-29 Richard Stallman <rms@gnu.org> + + * font-lock.el (font-lock-prepend-text-property) + (font-lock-append-text-property): Canonicalize the face and + font-lock-face properties. + + * faces.el (facep): Doc fix. + + * startup.el (fancy-startup-tail, fancy-about-text) + (fancy-startup-text): Regularize format of face property. + + * facemenu.el (list-colors-print): Use :background and :foreground + instead of background-color and foreground-color. + +2007-12-29 Drew Adams <drew.adams@oracle.com> + + * cus-edit.el (custom-add-parent-links): + Fill the "Parent documentation" text. + +2007-12-29 Eli Zaretskii <eliz@gnu.org> + + * textmodes/ispell.el (ispell-grep-command): Use "grep" on + MS-Windows and MS-DOS. + (ispell-grep-options): Use "-Ei" on MS-Windows and MS-DOS. + +2008-01-02 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc-svn.el (vc-svn-modify-change comment): New function. + +2008-01-01 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el (vc-git-dir-state): Set the vc-backend property. Do + not disable undo, with-temp-buffer does it by default. + +2008-01-01 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc-svn.el (vc-svn-parse-status): Set the 'unregisted property + correctly. + + * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call + with vc-state. + (vc-next-action): Fix vc-transfer-file call. + +2007-12-31 Tom Tromey <tromey@redhat.com> + + * emacs-lisp/elp.el (elp-results): Use header-line-format for + header. Move point to the start of the buffer. + +2007-12-31 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-cvs.el (vc-cvs-parse-entry): Set the vc-backend property. + + * vc.el: State that dir-state is required to set the vc-state and + vc-backend properties. + +2007-12-31 Martin Rudalics <rudalics@gmx.at> + + * man.el (Man-default-man-entry): Make this a defun. Improve + guessing mechanism and handling of section numbers. + +2007-12-31 Richard Stallman <rms@gnu.org> + + * faces.el (face-all-attributes): If FRAME is nil, return defaults. + +2007-12-31 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (calc-convert-temperature): Ensure that units + are on the result even when the result is zero. + +2007-12-30 Michael Albinus <michael.albinus@gmx.de> + + * net/dbus.el (dbus-name-owner-changed-handler): Make the function + resistent towards wrong parameters. + (dbus-handle-event): Propagate D-Bus errors only in the debug case. + +2007-12-30 Richard Stallman <rms@gnu.org> + + * faces.el (face-all-attributes): New function. + + * faces.el (face-differs-from-default-p): Compute list of attr names + from face-attribute-name-alist. + + * cus-edit.el (custom-face-set): Call `face-spec-set' with FOR-DEFFACE. + (custom-face-save): Likewise. + (custom-face-reset-saved, custom-face-reset-standard): Likewise. + + * cus-face.el (custom-declare-face): Per frame, use `face-spec-set-2'. + (custom-theme-set-faces): Clear `face-override-spec' property. + Call `face-spec-set' with FOR-DEFFACE. + + * custom.el (custom-theme-recalc-face): + Simply call `face-spec-recalc'. + + * faces.el (face-spec-set): Third arg is now FOR-DEFFACE. + Use of frame as third arg is deprecated. + Handle `face-override-spec' property. + (face-spec-recalc): New function. + (face-spec-set-2): New function. + (frame-set-background-mode): Handle `face-override-spec' property. + Use `face-spec-recalc'. + (face-set-after-frame-default): Use `face-spec-recalc'. + +2007-12-29 Nick Roberts <nickrob@snap.net.nz> + + * thumbs.el (thumbs-conversion-program): Add comment for Windows XP. + +2007-12-29 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-dir-state): Set the vc-backend property. + +2007-12-29 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc-svn.el (vc-svn-parse-status): Recognize 'unregistered, + 'added, 'removed. + + * vc.el (header coment): Better description of dir-state. + (vc-compatible-state): New function. Checks whether two states + can be in the same changeset; used with 'edited it can test whether + the next action for a state should be commit. + (vc-default-dired-format0info): Display 'added state. + (vc-dired-hook): Turn off undo, this is a speed tweak. + + * vc-bzr.el (vc-bzr-dir-state): Recognize 'added. + + * vc-hg.el (vc-bzr-hg-state): Recognize 'added and 'removed. + Cope with the possibility that the 'C' status flag might change + in 0.9,6. + + * vc-git.el (vc-bzr-dir-state): Recognize 'removed. + +2007-12-29 Thien-Thi Nguyen <ttn@gnuvola.org> + + * files.el (cd-absolute): Fix omission bug: + Make `list-buffers-directory' buffer-local. + +2007-12-29 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-dir-state): Deal with the up-to-date state. + 2007-12-29 Jay Belanger <jay.p.belanger@gmail.com> * calc/calc-aent.el (math-read-token): Fix misplaced @@ -29,6 +178,10 @@ * calc/calc-help.el (calc-d-prefix-help): Add new languages. * calc/calc-menu.el (calc-modes-menu): Add new languages. + (calc-arithmetic-menu, calc-scientific-function-menu) + (calc-algebra-menu, calc-graphics-menu, calc-vectors-menu) + (calc-units-menu, calc-variables-menu, calc-stack-menu): + Add :active keywords. 2007-12-28 Dan Nicolaescu <dann@ics.uci.edu>
--- a/lisp/calc/calc-lang.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/calc/calc-lang.el Wed Jan 02 04:13:39 2008 +0000 @@ -1759,6 +1759,8 @@ '(( infinity . var-inf) ( infinity . var-uinf))) +(put 'giac 'math-complex-format 'i) + (add-to-list 'calc-lang-allow-underscores 'giac) (put 'giac 'math-compose-subscr
--- a/lisp/calc/calc-menu.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/calc/calc-menu.el Wed Jan 02 04:13:39 2008 +0000 @@ -26,46 +26,58 @@ (defvar calc-arithmetic-menu (list "Arithmetic" (list "Basic" - ["-(1:)" calc-change-sign :keys "n"] - ["(2:) + (1:)" calc-plus :keys "+"] - ["(2:) - (1:)" calc-minus :keys "-"] - ["(2:) * (1:)" calc-times :keys "*"] - ["(2:) / (1:)" calc-divide :keys "/"] - ["(2:) ^ (1:)" calc-power :keys "^"] + ["-(1:)" calc-change-sign + :keys "n" :active (>= (calc-stack-size) 1)] + ["(2:) + (1:)" calc-plus + :keys "+" :active (>= (calc-stack-size) 2)] + ["(2:) - (1:)" calc-minus + :keys "-" :active (>= (calc-stack-size) 2)] + ["(2:) * (1:)" calc-times + :keys "*" :active (>= (calc-stack-size) 2)] + ["(2:) / (1:)" calc-divide + :keys "/" :active (>= (calc-stack-size) 2)] + ["(2:) ^ (1:)" calc-power + :keys "^" :active (>= (calc-stack-size) 2)] ["(2:) ^ (1/(1:))" (progn (require 'calc-ext) (let ((calc-inverse-flag t)) (call-interactively 'calc-power))) :keys "I ^" + :active (>= (calc-stack-size) 2) :help "The (1:)th root of (2:)"] ["abs(1:)" (progn (require 'calc-arith) (call-interactively 'calc-abs)) :keys "A" + :active (>= (calc-stack-size) 1) :help "Absolute value"] ["1/(1:)" (progn (require 'calc-arith) (call-interactively 'calc-inv)) - :keys "&"] + :keys "&" + :active (>= (calc-stack-size) 1)] ["sqrt(1:)" (progn (require 'calc-math) (call-interactively 'calc-sqrt)) - :keys "Q"] + :keys "Q" + :active (>= (calc-stack-size) 1)] ["idiv(2:,1:)" (progn (require 'calc-arith) (call-interactively 'calc-idiv)) :keys "\\" + :active (>= (calc-stack-size) 2) :help "The integer quotient of (2:) over (1:)"] ["(2:) mod (1:)" (progn (require 'calc-misc) (call-interactively 'calc-mod)) :keys "%" + :active (>= (calc-stack-size) 2) :help "The remainder when (2:) is divided by (1:)"]) (list "Rounding" ["floor(1:)" @@ -73,64 +85,75 @@ (require 'calc-arith) (call-interactively 'calc-floor)) :keys "F" + :active (>= (calc-stack-size) 1) :help "The greatest integer less than or equal to (1:)"] ["ceiling(1:)" (progn (require 'calc-arith) (call-interactively 'calc-ceiling)) :keys "I F" + :active (>= (calc-stack-size) 1) :help "The smallest integer greater than or equal to (1:)"] ["round(1:)" (progn (require 'calc-arith) (call-interactively 'calc-round)) :keys "R" + :active (>= (calc-stack-size) 1) :help "The nearest integer to (1:)"] ["truncate(1:)" (progn (require 'calc-arith) (call-interactively 'calc-trunc)) :keys "I R" + :active (>= (calc-stack-size) 1) :help "The integer part of (1:)"]) (list "Complex Numbers" ["Re(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-re)) - :keys "f r"] + :keys "f r" + :active (>= (calc-stack-size) 1)] ["Im(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-im)) - :keys "f i"] + :keys "f i" + :active (>= (calc-stack-size) 1)] ["conj(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-conj)) :keys "J" + :active (>= (calc-stack-size) 1) :help "The complex conjugate of (1:)"] ["length(1:)" (progn (require 'calc-arith) (call-interactively 'calc-abs)) :keys "A" + :active (>= (calc-stack-size) 1) :help "The length (absolute value) of (1:)"] ["arg(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-argument)) :keys "G" + :active (>= (calc-stack-size) 1) :help "The argument (polar angle) of (1:)"]) (list "Conversion" ["Convert (1:) to a float" (progn (require 'calc-ext) (call-interactively 'calc-float)) - :keys "c f"] + :keys "c f" + :active (>= (calc-stack-size) 1)] ["Convert (1:) to a fraction" (progn (require 'calc-ext) (call-interactively 'calc-fraction)) - :keys "c F"]) + :keys "c F" + :active (>= (calc-stack-size) 1)]) (list "Binary" ["Set word size" (progn @@ -142,60 +165,70 @@ (require 'calc-bin) (call-interactively 'calc-clip)) :keys "b c" + :active (>= (calc-stack-size) 1) :help "Reduce (1:) modulo 2^wordsize"] ["(2:) and (1:)" (progn (require 'calc-bin) (call-interactively 'calc-and)) :keys "b a" + :active (>= (calc-stack-size) 2) :help "Bitwise AND [modulo 2^wordsize]"] ["(2:) or (1:)" (progn (require 'calc-bin) (call-interactively 'calc-or)) :keys "b o" + :active (>= (calc-stack-size) 2) :help "Bitwise inclusive OR [modulo 2^wordsize]"] ["(2:) xor (1:)" (progn (require 'calc-bin) (call-interactively 'calc-xor)) :keys "b x" + :active (>= (calc-stack-size) 2) :help "Bitwise exclusive OR [modulo 2^wordsize]"] ["diff(2:,1:)" (progn (require 'calc-bin) (call-interactively 'calc-diff)) :keys "b d" + :active (>= (calc-stack-size) 2) :help "Bitwise difference [modulo 2^wordsize]"] ["not (1:)" (progn (require 'calc-bin) (call-interactively 'calc-not)) :keys "b n" + :active (>= (calc-stack-size) 1) :help "Bitwise NOT [modulo 2^wordsize]"] ["left shift(1:)" (progn (require 'calc-bin) (call-interactively 'calc-lshift-binary)) :keys "b l" + :active (>= (calc-stack-size) 1) :help "Shift (1:)[modulo 2^wordsize] one bit left"] ["right shift(1:)" (progn (require 'calc-bin) (call-interactively 'calc-rshift-binary)) :keys "b r" + :active (>= (calc-stack-size) 1) :help "Shift (1:)[modulo 2^wordsize] one bit right, putting 0s on the left"] ["arithmetic right shift(1:)" (progn (require 'calc-bin) (call-interactively 'calc-rshift-arith)) :keys "b R" + :active (>= (calc-stack-size) 1) :help "Shift (1:)[modulo 2^wordsize] one bit right, duplicating the leftmost bit"] ["rotate(1:)" (progn (require 'calc-bin) (call-interactively 'calc-rotate-binary)) :keys "b t" + :active (>= (calc-stack-size) 1) :help "Rotate (1:)[modulo 2^wordsize] one bit left"]) "-------" ["Help on Arithmetic" @@ -237,69 +270,82 @@ (require 'calc-math) (call-interactively 'calc-ln)) :keys "L" + :active (>= (calc-stack-size) 1) :help "The natural logarithm"] ["e^(1:)" (progn (require 'calc-math) (call-interactively 'calc-exp)) - :keys "E"] + :keys "E" + :active (>= (calc-stack-size) 1)] ["log(1:) [base 10]" (progn (require 'calc-math) (call-interactively 'calc-log10)) :keys "H L" + :active (>= (calc-stack-size) 1) :help "The common logarithm"] ["10^(1:)" (progn (require 'calc-math) (let ((calc-inverse-flag t)) (call-interactively 'calc-log10))) - :keys "I H L"] + :keys "I H L" + :active (>= (calc-stack-size) 1)] ["log(2:) [base(1:)]" (progn (require 'calc-math) (call-interactively 'calc-log)) :keys "B" + :active (>= (calc-stack-size) 2) :help "The logarithm with an arbitrary base"] ["(2:) ^ (1:)" calc-power - :keys "^"]) + :keys "^" + :active (>= (calc-stack-size) 2)]) (list "Trigonometric Functions" ["sin(1:)" (progn (require 'calc-math) (call-interactively 'calc-sin)) - :keys "S"] + :keys "S" + :active (>= (calc-stack-size) 1)] ["cos(1:)" (progn (require 'calc-math) (call-interactively 'calc-cos)) - :keys "C"] + :keys "C" + :active (>= (calc-stack-size) 1)] ["tan(1:)" (progn (require 'calc-math) (call-interactively 'calc-tan)) - :keys "T"] + :keys "T" + :active (>= (calc-stack-size) 1)] ["arcsin(1:)" (progn (require 'calc-math) (call-interactively 'calc-arcsin)) - :keys "I S"] + :keys "I S" + :active (>= (calc-stack-size) 1)] ["arccos(1:)" (progn (require 'calc-math) (call-interactively 'calc-arccos)) - :keys "I C"] + :keys "I C" + :active (>= (calc-stack-size) 1)] ["arctan(1:)" (progn (require 'calc-math) (call-interactively 'calc-arctan)) - :keys "I T"] + :keys "I T" + :active (>= (calc-stack-size) 1)] ["arctan2(2:,1:)" (progn (require 'calc-math) (call-interactively 'calc-arctan2)) - :keys "f T"] + :keys "f T" + :active (>= (calc-stack-size) 2)] "--Angle Measure--" ["Radians" (progn @@ -327,133 +373,157 @@ (progn (require 'calc-math) (call-interactively 'calc-sinh)) - :keys "H S"] + :keys "H S" + :active (>= (calc-stack-size) 1)] ["cosh(1:)" (progn (require 'calc-math) (call-interactively 'calc-cosh)) - :keys "H C"] + :keys "H C" + :active (>= (calc-stack-size) 1)] ["tanh(1:)" (progn (require 'calc-math) (call-interactively 'calc-tanh)) - :keys "H T"] + :keys "H T" + :active (>= (calc-stack-size) 1)] ["arcsinh(1:)" (progn (require 'calc-math) (call-interactively 'calc-arcsinh)) - :keys "I H S"] + :keys "I H S" + :active (>= (calc-stack-size) 1)] ["arccosh(1:)" (progn (require 'calc-math) (call-interactively 'calc-arccosh)) - :keys "I H C"] + :keys "I H C" + :active (>= (calc-stack-size) 1)] ["arctanh(1:)" (progn (require 'calc-math) (call-interactively 'calc-arctanh)) - :keys "I H T"]) + :keys "I H T" + :active (>= (calc-stack-size) 1)]) (list "Advanced Math Functions" ["Gamma(1:)" (progn (require 'calc-comb) (call-interactively 'calc-gamma)) :keys "f g" + :active (>= (calc-stack-size) 1) :help "The Euler Gamma function"] ["GammaP(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-inc-gamma)) :keys "f G" + :active (>= (calc-stack-size) 2) :help "The lower incomplete Gamma function"] ["Beta(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-beta)) :keys "f b" + :active (>= (calc-stack-size) 2) :help "The Euler Beta function"] ["BetaI(3:,2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-inc-beta)) :keys "f B" + :active (>= (calc-stack-size) 3) :help "The incomplete Beta function"] ["erf(1:)" (progn (require 'calc-funcs) (call-interactively 'calc-erf)) :keys "f e" + :active (>= (calc-stack-size) 1) :help "The error function"] ["BesselJ(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-bessel-J)) :keys "f j" + :active (>= (calc-stack-size) 2) :help "The Bessel function of the first kind (of order (2:))"] ["BesselY(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-bessel-Y)) :keys "f y" + :active (>= (calc-stack-size) 2) :help "The Bessel function of the second kind (of order (2:))"]) (list "Combinatorial Functions" ["gcd(2:,1:)" (progn (require 'calc-comb) (call-interactively 'calc-gcd)) - :keys "k g"] + :keys "k g" + :active (>= (calc-stack-size) 2)] ["lcm(2:,1:)" (progn (require 'calc-comb) (call-interactively 'calc-lcm)) - :keys "k l"] + :keys "k l" + :active (>= (calc-stack-size) 2)] ["factorial(1:)" (progn (require 'calc-comb) (call-interactively 'calc-factorial)) - :keys "!"] + :keys "!" + :active (>= (calc-stack-size) 1)] ["(2:) choose (1:)" (progn (require 'calc-comb) (call-interactively 'calc-choose)) - :keys "k c"] + :keys "k c" + :active (>= (calc-stack-size) 2)] ["permutations(2:,1:)" (progn (require 'calc-comb) (call-interactively 'calc-perm)) - :keys "H k c"] + :keys "H k c" + :active (>= (calc-stack-size) 2)] ["Primality test for (1:)" (progn (require 'calc-comb) (call-interactively 'calc-prime-test)) :keys "k p" + :active (>= (calc-stack-size) 1) :help "For large (1:), a probabilistic test"] ["Factor (1:) into primes" (progn (require 'calc-comb) (call-interactively 'calc-prime-factors)) - :keys "k f"] + :keys "k f" + :active (>= (calc-stack-size) 1)] ["Next prime after (1:)" (progn (require 'calc-comb) (call-interactively 'calc-next-prime)) - :keys "k n"] + :keys "k n" + :active (>= (calc-stack-size) 1)] ["Previous prime before (1:)" (progn (require 'calc-comb) (call-interactively 'calc-prev-prime)) - :keys "I k n"] + :keys "I k n" + :active (>= (calc-stack-size) 1)] ["phi(1:)" (progn (require 'calc-comb) (call-interactively 'calc-totient)) :keys "k n" + :active (>= (calc-stack-size) 1) :help "Euler's totient function"] ["random(1:)" (progn (require 'calc-comb) (call-interactively 'calc-random)) :keys "k r" + :active (>= (calc-stack-size) 1) :help "A random number >=1 and < (1:)"]) "----" ["Help on Scientific Functions" @@ -467,12 +537,14 @@ (progn (require 'calc-alg) (call-interactively 'calc-simplify)) - :keys "a s"] + :keys "a s" + :active (>= (calc-stack-size) 1)] ["Simplify (1:) with extended rules" (progn (require 'calc-alg) (call-interactively 'calc-simplify-extended)) :keys "a e" + :active (>= (calc-stack-size) 1) :help "Apply possibly unsafe simplifications"]) (list "Manipulation" ["Expand formula (1:)" @@ -480,17 +552,20 @@ (require 'calc-alg) (call-interactively 'calc-expand-formula)) :keys "a \"" + :active (>= (calc-stack-size) 1) :help "Expand (1:) into its defining formula, if possible"] ["Evaluate variables in (1:)" (progn (require 'calc-ext) (call-interactively 'calc-evaluate)) - :keys "="] + :keys "=" + :active (>= (calc-stack-size) 1)] ["Make substitution in (1:)" (progn (require 'calc-alg) (call-interactively 'calc-substitute)) :keys "a b" + :active (>= (calc-stack-size) 1) :help "Substitute all occurrences of a sub-expression with a new sub-expression"]) (list "Polynomials" @@ -498,87 +573,102 @@ (progn (require 'calc-alg) (call-interactively 'calc-factor)) - :keys "a f"] + :keys "a f" + :active (>= (calc-stack-size) 1)] ["Collect terms in (1:)" (progn (require 'calc-alg) (call-interactively 'calc-collect)) :keys "a c" + :active (>= (calc-stack-size) 1) :help "Arrange as a polynomial in a given variable"] ["Expand (1:)" (progn (require 'calc-alg) (call-interactively 'calc-expand)) :keys "a x" + :active (>= (calc-stack-size) 1) :help "Apply distributive law everywhere"] ["Find roots of (1:)" (progn (require 'calcalg2) (call-interactively 'calc-poly-roots)) - :keys "a P"]) + :keys "a P" + :active (>= (calc-stack-size) 1)]) (list "Calculus" ["Differentiate (1:)" (progn (require 'calcalg2) (call-interactively 'calc-derivative)) - :keys "a d"] + :keys "a d" + :active (>= (calc-stack-size) 1)] ["Integrate (1:) [indefinite]" (progn (require 'calcalg2) (call-interactively 'calc-integral)) - :keys "a i"] + :keys "a i" + :active (>= (calc-stack-size) 1)] ["Integrate (1:) [definite]" (progn (require 'calcalg2) (let ((var (read-string "Integration variable: "))) (calc-tabular-command 'calcFunc-integ "Integration" "intg" nil var nil nil))) - :keys "C-u a i"] + :keys "C-u a i" + :active (>= (calc-stack-size) 1)] ["Integrate (1:) [numeric]" (progn (require 'calcalg2) (call-interactively 'calc-num-integral)) :keys "a I" + :active (>= (calc-stack-size) 1) :help "Integrate using the open Romberg method"] ["Taylor expand (1:)" (progn (require 'calcalg2) (call-interactively 'calc-taylor)) - :keys "a t"] + :keys "a t" + :active (>= (calc-stack-size) 1)] ["Minimize (2:) [initial guess = (1:)]" (progn (require 'calcalg3) (call-interactively 'calc-find-minimum)) :keys "a N" + :active (>= (calc-stack-size) 2) :help "Find a local minimum"] ["Maximize (2:) [initial guess = (1:)]" (progn (require 'calcalg3) (call-interactively 'calc-find-maximum)) :keys "a X" + :active (>= (calc-stack-size) 2) :help "Find a local maximum"]) (list "Solving" ["Solve equation (1:)" (progn (require 'calcalg2) (call-interactively 'calc-solve-for)) - :keys "a S"] + :keys "a S" + :active (>= (calc-stack-size) 1)] ["Solve equation (2:) numerically [initial guess = (1:)]" (progn (require 'calcalg3) (call-interactively 'calc-find-root)) - :keys "a R"] + :keys "a R" + :active (>= (calc-stack-size) 2)] ["Find roots of polynomial (1:)" (progn (require 'calcalg2) (call-interactively 'calc-poly-roots)) - :keys "a P"]) + :keys "a P" + :active (>= (calc-stack-size) 1)]) (list "Curve Fitting" ["Fit (1:)=[x values, y values] to a curve" (progn (require 'calcalg3) (call-interactively 'calc-curve-fit)) - :keys "a F"]) + :keys "a F" + :active (>= (calc-stack-size) 1)]) "----" ["Help on Algebra" (calc-info-goto-node "Algebra")]) @@ -591,12 +681,14 @@ (progn (require 'calc-graph) (call-interactively 'calc-graph-fast)) - :keys "g f"] + :keys "g f" + :active (>= (calc-stack-size) 2)] ["Graph 3D [(1:)= z values, (2:)= y values, (3:)= x values]" (progn (require 'calc-graph) (call-interactively 'calc-graph-fast-3d)) - :keys "g F"] + :keys "g F" + :active (>= (calc-stack-size) 3)] "----" ["Help on Graphics" (calc-info-goto-node "Graphics")]) @@ -606,14 +698,18 @@ (defvar calc-vectors-menu (list "Matrices/Vectors" (list "Matrices" - ["(2:) + (1:)" calc-plus :keys "+"] - ["(2:) - (1:)" calc-minus :keys "-"] - ["(2:) * (1:)" calc-times :keys "*"] - ["(1:)^(-1)" + ["(2:) + (1:)" calc-plus + :keys "+" :active (>= (calc-stack-size) 2)] + ["(2:) - (1:)" calc-minus + :keys "-" :active (>= (calc-stack-size) 2)] + ["(2:) * (1:)" calc-times + :keys "*" :active (>= (calc-stack-size) 2)] + ["(1:)^(-1)" (progn (require 'calc-arith) (call-interactively 'calc-inv)) - :keys "&"] + :keys "&" + :active (>= (calc-stack-size) 1)] ["Create an identity matrix" (progn (require 'calc-vec) @@ -623,179 +719,211 @@ (progn (require 'calc-vec) (call-interactively 'calc-transpose)) - :keys "v t"] + :keys "v t" + :active (>= (calc-stack-size) 1)] ["det(1:)" (progn (require 'calc-mtx) (call-interactively 'calc-mdet)) - :keys "V D"] + :keys "V D" + :active (>= (calc-stack-size) 1)] ["trace(1:)" (progn (require 'calc-mtx) (call-interactively 'calc-mtrace)) - :keys "V T"] + :keys "V T" + :active (>= (calc-stack-size) 1)] ["LUD decompose (1:)" (progn (require 'calc-mtx) (call-interactively 'calc-mlud)) - :keys "V L"] + :keys "V L" + :active (>= (calc-stack-size) 1)] ["Extract a row from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-mrow)) - :keys "v r"] + :keys "v r" + :active (>= (calc-stack-size) 1)] ["Extract a column from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-mcol)) - :keys "v c"]) + :keys "v c" + :active (>= (calc-stack-size) 1)]) (list "Vectors" ["Extract the first element of (1:)" (progn (require 'calc-vec) (call-interactively 'calc-head)) - :keys "v h"] + :keys "v h" + :active (>= (calc-stack-size) 1)] ["Extract an element from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-mrow)) - :keys "v r"] + :keys "v r" + :active (>= (calc-stack-size) 1)] ["Reverse (1:)" (progn (require 'calc-vec) (call-interactively 'calc-reverse-vector)) - :keys "v v"] + :keys "v v" + :active (>= (calc-stack-size) 1)] ["Unpack (1:)" (progn (require 'calc-vec) (call-interactively 'calc-unpack)) :keys "v u" + :active (>= (calc-stack-size) 1) :help "Separate the elements of (1:)"] ["(2:) cross (1:)" (progn (require 'calc-vec) (call-interactively 'calc-cross)) :keys "V C" + :active (>= (calc-stack-size) 2) :help "The cross product in R^3"] ["(2:) dot (1:)" calc-mult :keys "*" + :active (>= (calc-stack-size) 2) :help "The dot product"] ["Map a function across (1:)" (progn (require 'calc-map) (call-interactively 'calc-map)) :keys "V M" + :active (>= (calc-stack-size) 1) :help "Apply a function to each element"]) (list "Vectors As Sets" ["Remove duplicates from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-remove-duplicates)) - :keys "V +"] + :keys "V +" + :active (>= (calc-stack-size) 1)] ["(2:) union (1:)" (progn (require 'calc-vec) (call-interactively 'calc-set-union)) - :keys "V V"] + :keys "V V" + :active (>= (calc-stack-size) 2)] ["(2:) intersect (1:)" (progn (require 'calc-vec) (call-interactively 'calc-set-intersect)) - :keys "V ^"] + :keys "V ^" + :active (>= (calc-stack-size) 2)] ["(2:) \\ (1:)" (progn (require 'calc-vec) (call-interactively 'calc-set-difference)) :keys "V -" - :help "Set difference"]) + :help "Set difference" + :active (>= (calc-stack-size) 2)]) (list "Statistics On Vectors" ["length(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-count)) :keys "u #" + :active (>= (calc-stack-size) 1) :help "The number of data values"] ["sum(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-sum)) :keys "u +" + :active (>= (calc-stack-size) 1) :help "The sum of the data values"] ["max(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-max)) :keys "u x" + :active (>= (calc-stack-size) 1) :help "The maximum of the data values"] ["min(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-min)) :keys "u N" + :active (>= (calc-stack-size) 1) :help "The minumum of the data values"] ["mean(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-mean)) :keys "u M" + :active (>= (calc-stack-size) 1) :help "The average (arithmetic mean) of the data values"] ["mean(1:) with error" (progn (require 'calc-stat) (call-interactively 'calc-vector-mean-error)) :keys "I u M" + :active (>= (calc-stack-size) 1) :help "The average (arithmetic mean) of the data values as an error form"] ["sdev(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-sdev)) :keys "u S" + :active (>= (calc-stack-size) 1) :help "The sample sdev, sqrt[sum((values - mean)^2)/(N-1)]"] ["variance(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-variance)) :keys "H u S" + :active (>= (calc-stack-size) 1) :help "The sample variance, sum((values - mean)^2)/(N-1)"] ["population sdev(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-pop-sdev)) :keys "I u S" + :active (>= (calc-stack-size) 1) :help "The population sdev, sqrt[sum((values - mean)^2)/N]"] ["population variance(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-pop-variance)) :keys "H I u S" + :active (>= (calc-stack-size) 1) :help "The population variance, sum((values - mean)^2)/N"] ["median(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-median)) :keys "H u M" + :active (>= (calc-stack-size) 1) :help "The median of the data values"] ["harmonic mean(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-harmonic-mean)) - :keys "H I u M"] + :keys "H I u M" + :active (>= (calc-stack-size) 1)] ["geometric mean(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-geometric-mean)) - :keys "u G"] + :keys "u G" + :active (>= (calc-stack-size) 1)] ["arithmetic-geometric mean(1:)" (progn (require 'calc-stat) (let ((calc-hyperbolic-flag t)) (call-interactively 'calc-vector-geometric-mean))) - :keys "H u G"] + :keys "H u G" + :active (>= (calc-stack-size) 1)] ["RMS(1:)" (progn (require 'calc-arith) (call-interactively 'calc-abs)) :keys "A" + :active (>= (calc-stack-size) 1) :help "The root-mean-square, or quadratic mean"]) ["Abbreviate long vectors" (progn @@ -815,17 +943,20 @@ (progn (require 'calc-units) (call-interactively 'calc-convert-units )) - :keys "u c"] + :keys "u c" + :active (>= (calc-stack-size) 1)] ["Convert temperature in (1:)" (progn (require 'calc-units) (call-interactively 'calc-convert-temperature)) - :keys "u t"] + :keys "u t" + :active (>= (calc-stack-size) 1)] ["Simplify units in (1:)" (progn (require 'calc-units) (call-interactively 'calc-simplify-units)) - :keys "u s"] + :keys "u s" + :active (>= (calc-stack-size) 1)] ["View units table" (progn (require 'calc-units) @@ -842,7 +973,8 @@ (progn (require 'calc-store) (call-interactively 'calc-store)) - :keys "s s"] + :keys "s s" + :active (>= (calc-stack-size) 1)] ["Recall a variable value" (progn (require 'calc-store) @@ -857,7 +989,8 @@ (progn (require 'calc-store) (call-interactively 'calc-store-exchange)) - :keys "s x"] + :keys "s x" + :active (>= (calc-stack-size) 1)] ["Clear variable value" (progn (require 'calc-store) @@ -867,12 +1000,14 @@ (progn (require 'calc-ext) (call-interactively 'calc-evaluate)) - :keys "="] + :keys "=" + :active (>= (calc-stack-size) 1)] ["Evaluate (1:), assigning a value to a variable" (progn (require 'calc-store) (call-interactively 'calc-let)) :keys "s l" + :active (>= (calc-stack-size) 1) :help "Evaluate (1:) under a temporary assignment of a variable"] "----" ["Help on Variables" @@ -883,18 +1018,22 @@ (list "Stack" ["Remove (1:)" calc-pop - :keys "DEL"] + :keys "DEL" + :active (>= (calc-stack-size) 1)] ["Switch (1:) and (2:)" calc-roll-down - :keys "TAB"] + :keys "TAB" + :active (>= (calc-stack-size) 2)] ["Duplicate (1:)" calc-enter - :keys "RET"] + :keys "RET" + :active (>= (calc-stack-size) 1)] ["Edit (1:)" (progn (require 'calc-yank) (call-interactively calc-edit)) - :keys "`"] + :keys "`" + :active (>= (calc-stack-size) 1)] "----" ["Help on Stack" (calc-info-goto-node "Stack and Trail")]) @@ -1051,6 +1190,47 @@ :keys "d e" :style radio :selected (eq (car-safe calc-float-format) 'eng)]) + (list "Complex Format" + ["Default" + (progn + (require 'calc-cplx) + (calc-complex-notation)) + :style radio + :selected (not calc-complex-format) + :keys "d c" + :help "Display complex numbers as ordered pairs."] + ["i notation" + (progn + (require 'calc-cplx) + (calc-i-notation)) + :style radio + :selected (eq calc-complex-format 'i) + :keys "d i" + :help "Display complex numbers as a+bi."] + ["j notation" + (progn + (require 'calc-cplx) + (calc-i-notation)) + :style radio + :selected (eq calc-complex-format 'j) + :keys "d j" + :help "Display complex numbers as a+bj."] + ["Other" + (calc-complex-notation) + :style radio + :selected (and calc-complex-format + (not (eq calc-complex-format 'i)) + (not (eq calc-complex-format 'j))) + :active nil] + "----" + ["Polar mode" + (progn + (require 'calc-cplx) + (calc-polar-mode nil)) + :style toggle + :selected (eq calc-complex-mode 'polar) + :keys "m p" + :help "Prefer polar form for complex numbers."]) (list "Algebraic" ["Normal" (progn @@ -1178,7 +1358,21 @@ (call-interactively 'calc-giac-language)) :keys "d A" :style radio - :selected (eq calc-language 'giac)]) + :selected (eq calc-language 'giac)] + ["Mma" + (progn + (require 'calc-lang) + (call-interactively 'calc-mathematica-language)) + :keys "d M" + :style radio + :selected (eq calc-language 'math)] + ["Maple" + (progn + (require 'calc-lang) + (call-interactively 'calc-maple-language)) + :keys "d W" + :style radio + :selected (eq calc-language 'maple)]) "----" ["Save mode settings" calc-save-modes :keys "m m"] "----"
--- a/lisp/calc/calc-units.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/calc/calc-units.el Wed Jan 02 04:13:39 2008 +0000 @@ -491,9 +491,14 @@ (when (eq (car-safe unew) 'error) (error "Bad format in units expression: %s" (nth 2 unew))) (math-put-default-units unew) - (calc-enter-result 1 "cvtm" (math-simplify-units - (math-convert-temperature expr uold unew - uoldname)))))) + (let ((ntemp (calc-normalize + (math-simplify-units + (math-convert-temperature expr uold unew + uoldname))))) + (if (Math-zerop ntemp) + (setq ntemp (list '* ntemp unew))) + (let ((calc-simplify-mode 'none)) + (calc-enter-result 1 "cvtm" ntemp)))))) (defun calc-remove-units () (interactive)
--- a/lisp/cus-edit.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/cus-edit.el Wed Jan 02 04:13:39 2008 +0000 @@ -1395,7 +1395,7 @@ (defun customize-apropos-options (regexp &optional arg) "Customize all loaded customizable options matching REGEXP. With prefix arg, include variables that are not customizable options -\(but we recommend using `apropos-variable' instead)." +\(but it is better to use `apropos-variable' if you want to find those)." (interactive "sCustomize options (regexp): \nP") (customize-apropos regexp (or arg 'options))) @@ -2258,7 +2258,8 @@ (insert ", ")))) (widget-put widget :buttons buttons)))) -(defun custom-add-parent-links (widget &optional initial-string) +(defun custom-add-parent-links (widget &optional initial-string + doc-initial-string) "Add \"Parent groups: ...\" to WIDGET if the group has parents. The value is non-nil if any parents were found. If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." @@ -2267,7 +2268,7 @@ (buttons (widget-get widget :buttons)) (start (point)) (parents nil)) - (insert (or initial-string "Parent groups:")) + (insert (or initial-string "Groups:")) (mapatoms (lambda (symbol) (when (member (list name type) (get symbol 'custom-group)) (insert " ") @@ -2286,23 +2287,27 @@ (get (car parents) 'custom-links)))) (many (> (length links) 2))) (when links - (insert "\nParent documentation: ") - (while links - (push (widget-create-child-and-convert - widget (car links) - :button-face 'custom-link - :mouse-face 'highlight - :pressed-face 'highlight) - buttons) - (setq links (cdr links)) - (cond ((null links) - (insert ".\n")) - ((null (cdr links)) - (if many - (insert ", and ") - (insert " and "))) - (t - (insert ", "))))))) + (let ((pt (point)) + (left-margin (+ left-margin 2))) + (insert "\n" (or doc-initial-string "Group documentation:") " ") + (while links + (push (widget-create-child-and-convert + widget (car links) + :button-face 'custom-link + :mouse-face 'highlight + :pressed-face 'highlight) + buttons) + (setq links (cdr links)) + (cond ((null links) + (insert ".\n")) + ((null (cdr links)) + (if many + (insert ", and ") + (insert " and "))) + (t + (insert ", ")))) + (fill-region-as-paragraph pt (point)) + (delete-to-left-margin (1+ pt) (+ pt 2)))))) (if parents (insert "\n") (delete-region start (point))) @@ -3496,10 +3501,10 @@ (put symbol 'customized-face value) (custom-push-theme 'theme-face symbol 'user 'set value) (if (face-spec-choose value) - (face-spec-set symbol value) + (face-spec-set symbol value t) ;; face-set-spec ignores empty attribute lists, so just give it ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)))) + (face-spec-set symbol '((t :foreground unspecified)) t)) (put symbol 'customized-face-comment comment) (put symbol 'face-comment comment) (custom-face-state-set widget) @@ -3518,10 +3523,10 @@ (custom-comment-hide comment-widget)) (custom-push-theme 'theme-face symbol 'user 'set value) (if (face-spec-choose value) - (face-spec-set symbol value) + (face-spec-set symbol value t) ;; face-set-spec ignores empty attribute lists, so just give it ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)))) + (face-spec-set symbol '((t :foreground unspecified)) t)) (unless (eq (widget-get widget :custom-state) 'standard) (put symbol 'saved-face value)) (put symbol 'customized-face nil) @@ -3548,7 +3553,7 @@ (put symbol 'customized-face nil) (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'set value) - (face-spec-set symbol value) + (face-spec-set symbol value t) (put symbol 'face-comment comment) (widget-value-set child value) ;; This call manages the comment visibility @@ -3572,7 +3577,7 @@ (put symbol 'customized-face nil) (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'reset) - (face-spec-set symbol value) + (face-spec-set symbol value t) (custom-theme-recalc-face symbol) (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) (put symbol 'saved-face nil) @@ -3894,7 +3899,8 @@ ;;; was made to display a group. (when (eq level 1) (if (custom-add-parent-links widget - "Parent groups:") + "Parent groups:" + "Parent group documentation:") (insert "\n")))) ;; Create level indicator. (insert-char ?\ (* custom-buffer-indent (1- level)))
--- a/lisp/cus-face.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/cus-face.el Wed Jan 02 04:13:39 2008 +0000 @@ -46,7 +46,7 @@ (make-empty-face face) ;; Create frame-local faces (dolist (frame (frame-list)) - (face-spec-set face value frame) + (face-spec-set-2 face frame value) (when (memq (window-system frame) '(x w32 mac)) (setq have-window-system t))) ;; When making a face after frames already exist @@ -342,7 +342,8 @@ (unless (facep face) (make-empty-face face)) (put face 'face-comment comment) - (face-spec-set face spec nil)) + (put face 'face-override-spec nil) + (face-spec-set face spec t)) (setq args (cdr args))) ;; Old format, a plist of FACE SPEC pairs. (let ((face (nth 0 args))
--- a/lisp/custom.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/custom.el Wed Jan 02 04:13:39 2008 +0000 @@ -1176,9 +1176,7 @@ (defun custom-theme-recalc-face (face) "Set FACE according to currently enabled custom themes." (if (facep face) - (let ((theme-faces (reverse (get face 'theme-face)))) - (dolist (spec theme-faces) - (face-spec-set face (cadr spec)))))) + (face-spec-recalc face))) ;;; XEmacs compability functions
--- a/lisp/emacs-lisp/elp.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/emacs-lisp/elp.el Wed Jan 02 04:13:39 2008 +0000 @@ -596,20 +596,39 @@ symname))))) elp-all-instrumented-list)) ) ; end let* - (insert title) - (if (> longest titlelen) - (progn - (insert-char 32 (- longest titlelen)) - (setq elp-field-len longest))) - (insert " " cc-header " " et-header " " at-header "\n") - (insert-char ?= elp-field-len) - (insert " ") - (insert-char ?= elp-cc-len) - (insert " ") - (insert-char ?= elp-et-len) - (insert " ") - (insert-char ?= elp-at-len) - (insert "\n") + ;; If printing to stdout, insert the header so it will print. + ;; Otherwise use header-line-format. + (setq elp-field-len (max titlelen longest)) + (if (or elp-use-standard-output noninteractive) + (progn + (insert title) + (if (> longest titlelen) + (progn + (insert-char 32 (- longest titlelen)))) + (insert " " cc-header " " et-header " " at-header "\n") + (insert-char ?= elp-field-len) + (insert " ") + (insert-char ?= elp-cc-len) + (insert " ") + (insert-char ?= elp-et-len) + (insert " ") + (insert-char ?= elp-at-len) + (insert "\n")) + (let ((column 0)) + (setq header-line-format + (mapconcat + (lambda (title) + (prog1 + (concat + (propertize " " + 'display (list 'space :align-to column) + 'face 'fixed-pitch) + title) + (setq column (+ column 1 + (if (= column 0) + elp-field-len + (length title)))))) + (list title cc-header et-header at-header) "")))) ;; if sorting is enabled, then sort the results list. in either ;; case, call elp-output-result to output the result in the ;; buffer @@ -621,7 +640,8 @@ (pop-to-buffer resultsbuf) ;; copy results to standard-output? (if (or elp-use-standard-output noninteractive) - (princ (buffer-substring (point-min) (point-max)))) + (princ (buffer-substring (point-min) (point-max))) + (goto-char (point-min))) ;; reset profiling info if desired (and elp-reset-after-results (elp-reset-all))))
--- a/lisp/facemenu.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/facemenu.el Wed Jan 02 04:13:39 2008 +0000 @@ -541,14 +541,14 @@ (insert (car color)) (indent-to 22)) (point) - 'face (cons 'background-color (car color))) + 'face (list ':background (car color))) (put-text-property (prog1 (point) (insert " " (if (cdr color) (mapconcat 'identity (cdr color) ", ") (car color)))) (point) - 'face (cons 'foreground-color (car color))) + 'face (list ':foreground (car color))) (indent-to (max (- (window-width) 8) 44)) (insert (apply 'format "#%02x%02x%02x" (mapcar (lambda (c) (lsh c -8))
--- a/lisp/faces.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/faces.el Wed Jan 02 04:13:39 2008 +0000 @@ -276,10 +276,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun facep (face) - "Return non-nil if FACE is a face name or internal face object. -Return nil otherwise. A face name can be a string or a symbol. -An internal face object is a vector of the kind used internally -to record face data." + "Return non-nil if FACE is a face name; nil otherwise. +A face name can be a string or a symbol." (internal-lisp-face-p face)) @@ -319,9 +317,7 @@ If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (let ((attrs - '(:family :width :height :weight :slant :foreground - :background :underline :overline :strike-through - :box :inverse-video)) + (delq :inherit (mapcar 'car face-attribute-name-alist))) (differs nil)) (while (and attrs (not differs)) (let* ((attr (pop attrs)) @@ -423,6 +419,17 @@ (symbol-name (check-face face))) +(defun face-all-attributes (face &optional frame) + "Return an alist stating the attributes of FACE. +Each element of the result has the form (ATTR-NAME . ATTR-VALUE). +Normally the value describes the default attributes, +but if you specify FRAME, the value describes the attributes +of FACE on FRAME." + (mapcar (lambda (pair) + (let ((attr (car pair))) + (cons attr (face-attribute face attr (or frame t))))) + face-attribute-name-alist)) + (defun face-attribute (face attribute &optional frame inherit) "Return the value of FACE's ATTRIBUTE on FRAME. If the optional argument FRAME is given, report on face FACE in that frame. @@ -1516,46 +1523,79 @@ (setq attrs (cdr attrs))))) -(defun face-spec-set (face spec &optional frame) - "Set FACE's attributes according to the first matching entry in SPEC. -FRAME is the frame whose frame-local face is set. FRAME nil means -do it on all frames (and change the default for new frames). -See `defface' for information about SPEC. If SPEC is nil, do nothing." - (let ((attrs (face-spec-choose spec frame))) - (when spec - (face-spec-reset-face face (or frame t))) +(defun face-spec-set (face spec &optional for-defface) + "Set FACE's face spec, which controls its appearance, to SPEC> +If FOR-DEFFACE is t, set the base spec, the one that `defface' + and Custom set. (In that case, the caller must put it in the + appropriate property, because that depends on the caller.) +If FOR-DEFFACE is nil, set the overriding spec (and store it + in the `face-override-spec' property of FACE). + +The appearance of FACE is controlled by the base spec, +by any custom theme specs on top of that, and by the +the overriding spec on top of all the rest. + +FOR-DEFFACE can also be a frame, in which case we set the +frame-specific attributes of FACE for that frame based on SPEC. +That usage is deprecated. + +See `defface' for information about the format and meaning of SPEC." + (if (framep for-defface) + ;; Handle the deprecated case where third arg is a frame. + (face-spec-set-2 face for-defface spec) + (if for-defface + ;; When we reset the face based on its custom spec, then it is + ;; unmodified as far as Custom is concerned. + (put (or (get face 'face-alias) face) 'face-modified nil) + ;; When we change a face based on a spec from outside custom, + ;; record it for future frames. + (put (or (get face 'face-alias) face) 'face-override-spec spec)) +;;; RMS 29 dec 2007: Perhaps this code should be reinstated. +;;; That depends on whether the overriding spec +;;; or the default face attributes +;;; should take priority. +;;; ;; Clear all the new-frame default attributes for this face. +;;; ;; face-spec-reset-face won't do it right. +;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) +;;; (dotimes (i (length facevec)) +;;; (unless (= i 0) +;;; (aset facevec i 'unspecified)))) + ;; Reset each frame according to the rules implied by all its specs. + (dolist (frame (frame-list)) + (face-spec-recalc face frame)))) + +(defun face-spec-recalc (face frame) + "Reset the face attributes of FACE on FRAME according to its specs. +This applies the defface/custom spec first, then the custom theme specs, +then the override spec." + (face-spec-reset-face face frame) + (let ((face-sym (or (get face 'face-alias) face))) + (face-spec-set-2 face frame + (face-user-default-spec face)) + (let ((theme-faces (reverse (get face-sym 'theme-face)))) + (dolist (spec theme-faces) + (face-spec-set-2 face frame (cadr spec)))) + (face-spec-set-2 face frame (get face-sym 'face-override-spec)))) + +(defun face-spec-set-2 (face frame spec) + "Set the face attributes of FACE on FRAME according to SPEC." + (let* ((attrs (face-spec-choose spec frame))) (while attrs (let ((attribute (car attrs)) (value (car (cdr attrs)))) ;; Support some old-style attribute names and values. (case attribute - (:bold (setq attribute :weight value (if value 'bold 'normal))) - (:italic (setq attribute :slant value (if value 'italic 'normal))) - ((:foreground :background) - ;; Compatibility with 20.x. Some bogus face specs seem to - ;; exist containing things like `:foreground nil'. - (if (null value) (setq value 'unspecified))) - (t (unless (assq attribute face-x-resources) - (setq attribute nil)))) + (:bold (setq attribute :weight value (if value 'bold 'normal))) + (:italic (setq attribute :slant value (if value 'italic 'normal))) + ((:foreground :background) + ;; Compatibility with 20.x. Some bogus face specs seem to + ;; exist containing things like `:foreground nil'. + (if (null value) (setq value 'unspecified))) + (t (unless (assq attribute face-x-resources) + (setq attribute nil)))) (when attribute - ;; If frame is nil, set the default for new frames. - ;; Existing frames are handled below. - (set-face-attribute face (or frame t) attribute value))) - (setq attrs (cdr (cdr attrs))))) - (unless frame - ;; When we reset the face based on its spec, then it is unmodified - ;; as far as Custom is concerned. - (put (or (get face 'face-alias) face) 'face-modified nil) -;;; ;; Clear all the new-frame defaults for this face. -;;; ;; face-spec-reset-face won't do it right. -;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) -;;; (dotimes (i (length facevec)) -;;; (unless (= i 0) -;;; (aset facevec i 'unspecified)))) - ;; Set each frame according to the rules implied by SPEC. - (dolist (frame (frame-list)) - (face-spec-set face spec frame)))) - + (set-face-attribute face frame attribute value))) + (setq attrs (cdr (cdr attrs)))))) (defun face-attr-match-p (face attrs &optional frame) "Return t if attributes of FACE match values in plist ATTRS. @@ -1868,14 +1908,16 @@ (let ((locally-modified-faces nil)) ;; Before modifying the frame parameters, we collect a list of ;; faces that don't match what their face-spec says they should - ;; look like; we then avoid changing these faces below. A - ;; negative list is used on the assumption that most faces will + ;; look like; we then avoid changing these faces below. + ;; These are the faces whose attributes were modified on FRAME. + ;; We use a negative list on the assumption that most faces will ;; be unmodified, so we can avoid consing in the common case. (dolist (face (face-list)) - (when (not (face-spec-match-p face - (face-user-default-spec face) - (selected-frame))) - (push face locally-modified-faces))) + (and (not (get face 'face-override-spec)) + (not (face-spec-match-p face + (face-user-default-spec face) + (selected-frame))) + (push face locally-modified-faces))) ;; Now change to the new frame parameters (modify-frame-parameters frame (list (cons 'background-mode bg-mode) @@ -1884,7 +1926,7 @@ ;; parameters, unless they have been locally modified. (dolist (face (face-list)) (unless (memq face locally-modified-faces) - (face-spec-set face (face-user-default-spec face) frame))))))) + (face-spec-recalc face frame))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2018,7 +2060,7 @@ (dolist (face (delq 'default (face-list))) (condition-case () (progn - (face-spec-set face (face-user-default-spec face) frame) + (face-spec-recalc face frame) (if (memq (window-system frame) '(x w32 mac)) (make-face-x-resource-internal face frame)) (internal-merge-in-global-face face frame))
--- a/lisp/files.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/files.el Wed Jan 02 04:13:39 2008 +0000 @@ -635,10 +635,10 @@ (if (file-exists-p dir) (error "%s is not a directory" dir) (error "%s: no such directory" dir)) - (if (file-executable-p dir) - (setq default-directory dir - list-buffers-directory dir) - (error "Cannot cd to %s: Permission denied" dir)))) + (unless (file-executable-p dir) + (error "Cannot cd to %s: Permission denied" dir)) + (setq default-directory dir) + (set (make-local-variable 'list-buffers-directory) dir))) (defun cd (dir) "Make DIR become the current buffer's default directory.
--- a/lisp/font-lock.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/font-lock.el Wed Jan 02 04:13:39 2008 +0000 @@ -1303,6 +1303,12 @@ (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) + ;; Canonicalize old forms of face property. + (and (memq prop '(face font-lock-face)) + (listp prev) + (or (keywordp (car prev)) + (memq (car prev) '(foreground-color background-color))) + (setq prev (list prev))) (put-text-property start next prop (append val (if (listp prev) prev (list prev))) object) @@ -1317,6 +1323,12 @@ (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) + ;; Canonicalize old forms of face property. + (and (memq prop '(face font-lock-face)) + (listp prev) + (or (keywordp (car prev)) + (memq (car prev) '(foreground-color background-color))) + (setq prev (list prev))) (put-text-property start next prop (append (if (listp prev) prev (list prev)) val) object)
--- a/lisp/man.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/man.el Wed Jan 02 04:13:39 2008 +0000 @@ -642,50 +642,91 @@ ;; ====================================================================== -;; default man entry: get word under point +;; default man entry: get word near point -(defsubst Man-default-man-entry (&optional pos) - "Make a guess at a default manual entry based on the text at POS. -If POS is nil, the current point is used." - (let (word start original-pos distance) +(defun Man-default-man-entry (&optional pos) + "Guess default manual entry based on the text near position POS. +POS defaults to `point'." + (let (word start pos column distance) (save-excursion - (if pos (goto-char pos)) - ;; Default man entry title is any word the cursor is on, or if - ;; cursor not on a word, nearest preceding or next word-like - ;; object on this line. - (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) + (when pos (goto-char pos)) + (setq pos (point)) + ;; The default title is the nearest entry-like object before or + ;; after POS. + (if (and (skip-chars-backward " \ta-zA-Z0-9+") + (not (zerop (skip-chars-backward "("))) + ;; Try to handle the special case where POS is on a + ;; section number. + (looking-at + (concat "([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) + ;; We skipped a valid section number backwards, look at + ;; preceding text. + (or (and (skip-chars-backward ",; \t") + (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))) + ;; Not a valid entry, move POS after closing paren. + (not (setq pos (match-end 0))))) + ;; We have a candidate, make `start' record its starting + ;; position. (setq start (point)) - (setq original-pos (point)) - (setq distance (abs (skip-chars-backward ",; \t"))) + ;; Otherwise look at char before POS. + (goto-char pos) (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) - (progn - (setq start (point)) - (goto-char original-pos) - (if (and (< (skip-chars-forward ",; \t") distance) - (looking-at "[-a-zA-Z0-9._+:]")) - (setq start (point)) - (goto-char start))) - (skip-chars-forward ",; \t") - (setq start (point)))) + ;; Our candidate is just before or around POS. + (setq start (point)) + ;; Otherwise record the current column and look backwards. + (setq column (current-column)) + (skip-chars-backward ",; \t") + ;; Record the distance travelled. + (setq distance (- column (current-column))) + (when (looking-back + (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)")) + ;; Skip section number backwards. + (goto-char (match-beginning 0)) + (skip-chars-backward " \t")) + (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) + (progn + ;; We have a candidate before POS ... + (setq start (point)) + (goto-char pos) + (if (and (skip-chars-forward ",; \t") + (< (- (current-column) column) distance) + (looking-at "[-a-zA-Z0-9._+:]")) + ;; ... but the one after POS is better. + (setq start (point)) + ;; ... and anything after POS is worse. + (goto-char start))) + ;; No candidate before POS. + (goto-char pos) + (skip-chars-forward ",; \t") + (setq start (point))))) + ;; We have found a suitable starting point, try to skip at least + ;; one character. (skip-chars-forward "-a-zA-Z0-9._+:") (setq word (buffer-substring-no-properties start (point))) ;; If there is a continuation at the end of line, check the ;; following line too, eg: ;; see this- ;; command-here(1) + ;; Note: This code gets executed iff our entry is after POS. (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") - (setq word (concat word (match-string-no-properties 1)))) + (setq word (concat word (match-string-no-properties 1))) + ;; Make sure the section number gets included by the code below. + (goto-char (match-end 1))) (when (string-match "[._]+$" word) (setq word (substring word 0 (match-beginning 0)))) - ;; If looking at something like *strcat(... , remove the '*' - (when (string-match "^*" word) - (setq word (substring word 1))) - ;; If looking at something like ioctl(2) or brc(1M), include the - ;; section number in the returned value. Remove text properties. - (concat word - (if (looking-at - (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) - (format "(%s)" (match-string-no-properties 1))))))) + ;; The following was commented out since the preceding code + ;; should not produce a leading "*" in the first place. +;;; ;; If looking at something like *strcat(... , remove the '*' +;;; (when (string-match "^*" word) +;;; (setq word (substring word 1))) + (concat + word + (and (not (string-equal word "")) + ;; If looking at something like ioctl(2) or brc(1M), + ;; include the section number in the returned value. + (looking-at + (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) + (format "(%s)" (match-string-no-properties 1))))))) ;; ======================================================================
--- a/lisp/net/dbus.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/net/dbus.el Wed Jan 02 04:13:39 2008 +0000 @@ -64,33 +64,50 @@ dbus-registered-functions-table) result)) -(defun dbus-name-owner-changed-handler (service old-owner new-owner) +(defun dbus-name-owner-changed-handler (&rest args) "Reapplies all signal registrations to D-Bus. This handler is applied when a \"NameOwnerChanged\" signal has arrived. SERVICE is the object name for which the name owner has been changed. OLD-OWNER is the previous owner of SERVICE, or the empty string if SERVICE was not owned yet. NEW-OWNER is the new -owner of SERVICE, or the empty string if SERVICE looses any name owner." +owner of SERVICE, or the empty string if SERVICE looses any name owner. + +usage: (dbus-name-owner-changed-handler service old-owner new-owner)" (save-match-data - ;; Check whether SERVICE is a known name. - (when (and (stringp service) (not (string-match "^:" service)) - (stringp old-owner) (stringp new-owner)) - (maphash - '(lambda (key value) - (dolist (elt value) - ;; key has the structure (BUS INTERFACE SIGNAL). - ;; elt has the structure (UNAME SERVICE PATH HANDLER). - (when (string-equal old-owner (car elt)) - ;; Remove old key, and add new entry with changed name. - (dbus-unregister-signal (list key (cdr elt))) - ;; Maybe we could arrange the lists a little bit better - ;; that we don't need to extract every single element? - (dbus-register-signal - ;; BUS SERVICE PATH - (nth 0 key) (nth 1 elt) (nth 2 elt) - ;; INTERFACE SIGNAL HANDLER - (nth 1 key) (nth 2 key) (nth 3 elt))))) - (copy-hash-table dbus-registered-functions-table))))) + ;; Check the arguments. We should silently ignore it when they + ;; are wrong. + (if (and (= (length args) 3) + (stringp (car args)) + (stringp (cadr args)) + (stringp (caddr args))) + (let ((service (car args)) + (old-owner (cadr args)) + (new-owner (caddr args))) + ;; Check whether SERVICE is a known name. + (when (not (string-match "^:" service)) + (maphash + '(lambda (key value) + (dolist (elt value) + ;; key has the structure (BUS INTERFACE SIGNAL). + ;; elt has the structure (UNAME SERVICE PATH HANDLER). + (when (string-equal old-owner (car elt)) + ;; Remove old key, and add new entry with changed name. + (dbus-unregister-signal (list key (cdr elt))) + ;; Maybe we could arrange the lists a little bit better + ;; that we don't need to extract every single element? + (dbus-register-signal + ;; BUS SERVICE PATH + (nth 0 key) (nth 1 elt) (nth 2 elt) + ;; INTERFACE SIGNAL HANDLER + (nth 1 key) (nth 2 key) (nth 3 elt))))) + (copy-hash-table dbus-registered-functions-table)))) + ;; The error is reported only in debug mode. + (when dbus-debug + (signal + 'dbus-error + (cons + (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus) + args)))))) ;; Register the handler. (condition-case nil @@ -148,11 +165,11 @@ (interactive "e") ;; We don't want to raise an error, because this function is called ;; in the event handling loop. - (condition-case nil + (condition-case err (progn (dbus-check-event event) (apply (nth 6 event) (nthcdr 7 event))) - (dbus-error))) + (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) (defun dbus-event-bus-name (event) "Return the bus name the event is coming from.
--- a/lisp/net/rcirc.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/net/rcirc.el Wed Jan 02 04:13:39 2008 +0000 @@ -1480,32 +1480,47 @@ (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) +(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name + "A function to generate the filename used by rcirc's logging facility. + +It is called with two arguments, PROCESS and TARGET (see +`rcirc-generate-new-buffer-name' for their meaning), and should +return the filename, or nil if no logging is desired for this +session. + +If the returned filename is absolute (`file-name-absolute-p' +returns true), then it is used as-is, otherwise the resulting +file is put into `rcirc-log-directory'." + :group 'rcirc + :type 'function) + (defun rcirc-log (process sender response target text) "Record line in `rcirc-log', to be later written to disk." - (let* ((filename (rcirc-generate-new-buffer-name process target)) - (cell (assoc-string filename rcirc-log-alist)) - (line (concat (format-time-string rcirc-time-format) - (substring-no-properties - (rcirc-format-response-string process sender - response target text)) - "\n"))) - (if cell - (setcdr cell (concat (cdr cell) line)) - (setq rcirc-log-alist - (cons (cons filename line) rcirc-log-alist))))) + (let ((filename (funcall rcirc-log-filename-function process target))) + (unless (null filename) + (let ((cell (assoc-string filename rcirc-log-alist)) + (line (concat (format-time-string rcirc-time-format) + (substring-no-properties + (rcirc-format-response-string process sender + response target text)) + "\n"))) + (if cell + (setcdr cell (concat (cdr cell) line)) + (setq rcirc-log-alist + (cons (cons filename line) rcirc-log-alist))))))) (defun rcirc-log-write () "Flush `rcirc-log-alist' data to disk. -Log data is written to `rcirc-log-directory'." - (make-directory rcirc-log-directory t) +Log data is written to `rcirc-log-directory', except for +log-files with absolute names (see `rcirc-log-filename-function')." (dolist (cell rcirc-log-alist) - (with-temp-buffer - (insert (cdr cell)) - (let ((coding-system-for-write 'utf-8)) - (write-region (point-min) (point-max) - (concat rcirc-log-directory "/" (car cell)) - t 'quiet)))) + (let ((filename (expand-file-name (car cell) rcirc-log-directory)) + (coding-system-for-write 'utf-8)) + (make-directory (file-name-directory filename) t) + (with-temp-buffer + (insert (cdr cell)) + (write-region (point-min) (point-max) filename t 'quiet)))) (setq rcirc-log-alist nil)) (defun rcirc-join-channels (process channels)
--- a/lisp/startup.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/startup.el Wed Jan 02 04:13:39 2008 +0000 @@ -1157,7 +1157,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar fancy-startup-text - '((:face (variable-pitch :foreground "red") + '((:face (variable-pitch (:foreground "red")) "Welcome to " :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) @@ -1203,7 +1203,7 @@ "\tView the Emacs manual using Info\n" :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) "\tGNU Emacs comes with " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch :link ("Copying Conditions" (lambda (button) (describe-copying))) @@ -1216,7 +1216,7 @@ `:face FACE', like `fancy-splash-insert' accepts them.") (defvar fancy-about-text - '((:face (variable-pitch :foreground "red") + '((:face (variable-pitch (:foreground "red")) "This is " :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) @@ -1232,13 +1232,14 @@ "Display info on the GNU project."))) " operating system.\n" :face (lambda () - (list 'variable-pitch :foreground - (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue"))) + (list 'variable-pitch + (list :foreground + (if (eq (frame-parameter nil 'background-mode) 'dark) + "cyan" "darkblue")))) "\n" (lambda () (emacs-version)) "\n" - :face (variable-pitch :height 0.5) + :face (variable-pitch (:height 0.5)) (lambda () emacs-copyright) "\n\n" :face variable-pitch @@ -1257,7 +1258,7 @@ "\tWhy we developed GNU Emacs, and the GNU operating system\n" :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) "\tGNU Emacs comes with " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch :link ("Copying Conditions" (lambda (button) (describe-copying))) @@ -1411,11 +1412,11 @@ (lambda (button) (customize-group 'initialization)) "Change initialization settings including this screen") "\n")) - (fancy-splash-insert :face `(variable-pitch :foreground ,fg) + (fancy-splash-insert :face `(variable-pitch (:foreground ,fg)) "\nThis is " (emacs-version) "\n" - :face '(variable-pitch :height 0.5) + :face '(variable-pitch (:height 0.5)) emacs-copyright "\n") (and auto-save-list-file-prefix @@ -1431,12 +1432,12 @@ (regexp-quote (file-name-nondirectory auto-save-list-file-prefix))) t) - (fancy-splash-insert :face '(variable-pitch :foreground "red") + (fancy-splash-insert :face '(variable-pitch (:foreground "red")) "\nIf an Emacs session crashed recently, " "type " :face '(fixed-pitch :foreground "red") "Meta-x recover-session RET" - :face '(variable-pitch :foreground "red") + :face '(variable-pitch (:foreground "red")) "\nto recover" " the files you were editing.")) @@ -1471,7 +1472,7 @@ (overlay-put button 'checked t) (overlay-put button 'display (overlay-get button :on-glyph)) (setq startup-screen-inhibit-startup-screen t))))) - (fancy-splash-insert :face '(variable-pitch :height 0.9) + (fancy-splash-insert :face '(variable-pitch (:height 0.9)) " Never show it again."))))) (defun exit-splash-screen ()
--- a/lisp/textmodes/ispell.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/textmodes/ispell.el Wed Jan 02 04:13:39 2008 +0000 @@ -336,12 +336,17 @@ :group 'ispell) -(defcustom ispell-grep-command "egrep" +(defcustom ispell-grep-command + ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they + ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options + ;; below). + (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep") "Name of the grep command for search processes." :type 'string :group 'ispell) -(defcustom ispell-grep-options "-i" +(defcustom ispell-grep-options + (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i") "String of options to use when running the program in `ispell-grep-command'. Should probably be \"-i\" or \"-e\". Some machines (like the NeXT) don't support \"-i\""
--- a/lisp/thumbs.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/thumbs.el Wed Jan 02 04:13:39 2008 +0000 @@ -93,6 +93,10 @@ :type 'integer :group 'thumbs) +;; Unfortunately Windows XP has a program called CONVERT.EXE in +;; C:/WINDOWS/SYSTEM32/ for partioning NTFS system. So Emacs +;; can find the one in your ImageMagick directory, you need to +;; customize this value to the absolute filename. (defcustom thumbs-conversion-program (if (eq system-type 'windows-nt) "convert.exe"
--- a/lisp/vc-bzr.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc-bzr.el Wed Jan 02 04:13:39 2008 +0000 @@ -522,7 +522,7 @@ (setq at-start nil) (cond ((looking-at "^added") - (setq current-vc-state 'edited) + (setq current-vc-state 'added) (setq current-bzr-state 'added)) ((looking-at "^kind changed") (setq current-vc-state 'edited)
--- a/lisp/vc-cvs.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc-cvs.el Wed Jan 02 04:13:39 2008 +0000 @@ -947,6 +947,7 @@ (cond ;; entry for a "locally added" file (not yet committed) ((looking-at "/[^/]+/0/") + (vc-file-setprop file 'vc-backend 'CVS) (vc-file-setprop file 'vc-checkout-time 0) (vc-file-setprop file 'vc-working-revision "0") (if set-state (vc-file-setprop file 'vc-state 'edited))) @@ -962,6 +963,7 @@ ;; sticky tag "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) "\\(.*\\)")) ;Sticky tag + (vc-file-setprop file 'vc-backend 'CVS) (vc-file-setprop file 'vc-working-revision (match-string 1)) (vc-file-setprop file 'vc-cvs-sticky-tag (vc-cvs-parse-sticky-tag (match-string 4)
--- a/lisp/vc-git.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc-git.el Wed Jan 02 04:13:39 2008 +0000 @@ -155,7 +155,6 @@ "Git-specific version of `dir-state'." ;; FIXME: This can't set 'ignored yet (with-temp-buffer - (buffer-disable-undo) ;; Because these buffers can get huge (vc-git-command (current-buffer) nil nil "ls-files" "-t" "-c" "-m" "-o") (goto-char (point-min)) (let ((status-char nil) @@ -168,19 +167,24 @@ (line-end-position)))) (cond ;; The rest of the possible states in "git ls-files -t" output: - ;; R removed/deleted ;; K to be killed ;; should not show up in vc-dired, so don't deal with them ;; here. ((eq status-char ?H) + (vc-file-setprop file 'vc-backend 'Git) (vc-file-setprop file 'vc-state 'up-to-date)) + ((eq status-char ?R) + (vc-file-setprop file 'vc-backend 'Git) + (vc-file-setprop file 'vc-state 'removed)) ((eq status-char ?M) + (vc-file-setprop file 'vc-backend 'Git) (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ?C) + (vc-file-setprop file 'vc-backend 'Git) (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ??) (vc-file-setprop file 'vc-backend 'none) - (vc-file-setprop file 'vc-state 'nil))) + (vc-file-setprop file 'vc-state nil))) (forward-line))))) (defun vc-git-working-revision (file)
--- a/lisp/vc-hg.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc-hg.el Wed Jan 02 04:13:39 2008 +0000 @@ -194,21 +194,35 @@ (buffer-substring-no-properties (+ (point) 2) (line-end-position)))) (cond + ;; State flag for a clean file is now C, might change to =. ;; The rest of the possible states in "hg status" output: - ;; R = removed ;; ! = deleted, but still tracked ;; should not show up in vc-dired, so don't deal with them ;; here. + ((eq status-char ?C) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'up-to-date)) ((eq status-char ?A) + (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-working-revision "0") - (vc-file-setprop file 'vc-state 'edited)) + (vc-file-setprop file 'vc-state 'added)) + ((eq status-char ?R) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'removed)) ((eq status-char ?M) + (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ?I) + (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-state 'ignored)) ((eq status-char ??) (vc-file-setprop file 'vc-backend 'none) - (vc-file-setprop file 'vc-state 'unregistered))) + (vc-file-setprop file 'vc-state 'unregistered)) + ((eq status-char ?!) + nil) + (t ;; Presently C, might change to = in 0.9.6 + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'up-to-date))) (forward-line))))) (defun vc-hg-working-revision (file)
--- a/lisp/vc-hooks.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc-hooks.el Wed Jan 02 04:13:39 2008 +0000 @@ -503,14 +503,16 @@ Often represented by vc-working-revision = \"0\" in VCSes with monotonic IDs like Subversion and Mercurial. - 'ignored The file showed up in a dir-state listing with a flag + 'removed Scheduled to be deleted from the repository on next commit. + + 'ignored The file showed up in a dir-state listing with a flag indicating the version-control system is ignoring it, Note: This property is not set reliably (some VCSes don't have useful directory-status commands) so assume that any file with vc-state nil might be ignorable without VC knowing it. - 'unregistered The file showed up in a dir-state listing with a flag + 'unregistered The file showed up in a dir-state listing with a flag indicating that it is not under version control. Note: This property is not set reliably (some VCSes don't have useful directory-status commands) so assume
--- a/lisp/vc-svn.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc-svn.el Wed Jan 02 04:13:39 2008 +0000 @@ -366,6 +366,30 @@ (error "Couldn't analyze svn update result"))) (message "Merging changes into %s...done" file)))) +(defun vc-svn-modify-change-comment (files rev comment) + "Modify the change comments for a specified REV. +You must have ssh access to the repository host, and the directory Emacs +uses locally for temp files must also be writeable by you on that host." + (vc-do-command nil 0 "svn" nil "info") + (set-buffer "*vc*") + (goto-char (point-min)) + (unless (re-search-forward "Repository Root: svn\\+ssh://\\([^/]+\\)\\(/.*\\)" nil t) + (error "Repository information is unavailable.")) + (let* ((tempfile (make-temp-file user-mail-address)) + (host (match-string 1)) + (directory (match-string 2)) + (remotefile (concat host ":" tempfile))) + (with-temp-buffer + (insert comment) + (write-region (point-min) (point-max) tempfile)) + (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile) + (error "Copy of comment to %s failed" remotefile)) + (unless (vc-do-command nil 0 "ssh" nil + "-q" host + (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s" + directory rev tempfile tempfile)) + (error "Log edit failed")) + )) ;;; ;;; History functions @@ -543,15 +567,16 @@ (let (file status) (goto-char (point-min)) (while (re-search-forward - ;; Ignore the files with status in [IX?]. - "^[ ACDGMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t) + ;; Ignore the files with status X. + "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) ;; If the username contains spaces, the output format is ambiguous, ;; so don't trust the output's filename unless we have to. (setq file (or filename (expand-file-name (buffer-substring (point) (line-end-position))))) (setq status (char-after (line-beginning-position))) - (unless (eq status ??) + (if (eq status ??) + (vc-file-setprop file 'vc-state 'unregistered) ;; `vc-BACKEND-registered' must not set vc-backend, ;; which is instead set in vc-registered. (unless filename (vc-file-setprop file 'vc-backend 'SVN)) @@ -573,15 +598,15 @@ ;; If the file was actually copied, (match-string 2) is "-". (vc-file-setprop file 'vc-working-revision "0") (vc-file-setprop file 'vc-checkout-time 0) - 'edited) + 'added) ((memq status '(?M ?C)) (if (eq (char-after (match-beginning 1)) ?*) 'needs-merge 'edited)) ((eq status ?I) (vc-file-setprop file 'vc-state 'ignored)) - ((eq status ??) - (vc-file-setprop file 'vc-state 'unregistered)) + ((eq status ?R) + (vc-file-setprop file 'vc-state 'removed)) (t 'edited))))) (if filename (vc-file-getprop filename 'vc-state))))
--- a/lisp/vc.el Sat Dec 29 02:51:57 2007 +0000 +++ b/lisp/vc.el Wed Jan 02 04:13:39 2008 +0000 @@ -159,11 +159,13 @@ ;; ;; - dir-state (dir) ;; -;; If provided, this function is used to find the version control state -;; of all files in DIR, and all subdirecties of DIR, in a fast way. -;; The function should not return anything, but rather store the files' -;; states into the corresponding `vc-state' properties. (Note: in -;; older versions this method was not required to recurse into +;; If provided, this function is used to find the version control +;; state of as many files as possible in DIR, and all subdirecties +;; of DIR, in a fast way; it is used to avoid expensive indivitual +;; vc-state calls. The function should not return anything, but +;; rather store the files' states into the corresponding properties. +;; Two properties are required: `vc-backend' and `vc-state'. (Note: +;; in older versions this method was not required to recurse into ;; subdirectories.) ;; ;; * working-revision (file) @@ -1346,6 +1348,12 @@ (defvar vc-dired-window-configuration) +(defun vc-compatible-state (p q) + "Controls which states can be in the same commit." + (or + (eq p q) + (and (member p '(edited added removed)) (member q '(edited added removed))))) + ;; Here's the major entry point. ;;;###autoload @@ -1386,7 +1394,7 @@ revision) ;; Verify that the fileset is homogenous (dolist (file (cdr files)) - (if (not (eq (vc-state file) state)) + (if (not (vc-compatible-state (vc-state file) state)) (error "Fileset is in a mixed-up state")) (if (not (eq (vc-checkout-model file) model)) (error "Fileset has mixed checkout models"))) @@ -1436,7 +1444,7 @@ ;; do nothing (message "Fileset is up-to-date")))) ;; Files have local changes - ((eq state 'edited) + ((vc-compatible-state state 'edited) (let ((ready-for-commit files)) ;; If files are edited but read-only, give user a chance to correct (dolist (file files) @@ -2349,7 +2357,9 @@ (if (and (vc-call-backend backend 'responsible-p default-directory) (vc-find-backend-function backend 'dir-state)) (vc-call-backend backend 'dir-state default-directory))) - (let (filename (inhibit-read-only t)) + (let (filename + (inhibit-read-only t) + (buffer-undo-list t)) (goto-char (point-min)) (while (not (eobp)) (cond @@ -2383,27 +2393,25 @@ (t (vc-dired-reformat-line nil) (forward-line 1)))) - ;; try to head off calling the expensive state query - + ;; Try to head off calling the expensive state query - ;; ignore object files, TeX intermediate files, and so forth. ((vc-dired-ignorable-p filename) (dired-kill-line)) - ;; ordinary file -- call the (possibly expensive) state query - (t - (let ((backend (vc-backend filename))) - (cond - ;; Not registered - ((not backend) - (if vc-dired-terse-mode - (dired-kill-line) - (vc-dired-reformat-line "?") - (forward-line 1))) - ;; Either we're in non-terse mode or it's out of date - ((not (and vc-dired-terse-mode (vc-up-to-date-p filename))) - (vc-dired-reformat-line (vc-call dired-state-info filename)) - (forward-line 1)) - ;; Remaining cases are under version control but uninteresting - (t - (dired-kill-line))))))) + ;; Ordinary file -- call the (possibly expensive) state query + ;; + ;; First case: unregistered or unknown. (Unknown shouldn't happen here) + ((member (vc-state filename) '(nil unregistered)) + (if vc-dired-terse-mode + (dired-kill-line) + (vc-dired-reformat-line "?") + (forward-line 1))) + ;; Either we're in non-terse mode or it's out of date + ((not (and vc-dired-terse-mode (vc-up-to-date-p filename))) + (vc-dired-reformat-line (vc-call dired-state-info filename)) + (forward-line 1)) + ;; Remaining cases are under version control but uninteresting + (t + (dired-kill-line)))) ;; any other line (t (forward-line 1)))) (vc-dired-purge)) @@ -3076,6 +3084,7 @@ ((eq state 'needs-merge) "(merge)") ((eq state 'needs-patch) "(patch)") ((eq state 'added) "(added)") + ((eq state 'removed) "(removed)") ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out ((eq state 'unregistered) "?") ((eq state 'unlocked-changes) "(stale)")
--- a/src/ChangeLog Sat Dec 29 02:51:57 2007 +0000 +++ b/src/ChangeLog Wed Jan 02 04:13:39 2008 +0000 @@ -1,3 +1,41 @@ +2007-12-31 Tom Tromey <tromey@redhat.com> (tiny change) + + * dbusbind.c (xd_read_message): Use non-static input_event struct. + +2007-12-31 Magnus Henoch <mange@freemail.hu> + + * dbusbind.c (xd_signature): Signature of variant is just "v". + +2007-12-30 Michael Albinus <michael.albinus@gmx.de> + + * dbusbind.c: Fix several errors and compiler warnings. Reported + by Tom Tromey <tromey@redhat.com> + (XD_ERROR, XD_DEBUG_MESSAGE) + (XD_DEBUG_VALID_LISP_OBJECT_P): Wrap code with "do ... while (0)". + (xd_append_arg): Part for basic D-Bus types rewitten. + (xd_retrieve_arg): Split implementation of DBUS_TYPE_BYTE and + DBUS_TYPE_(U)INT16. Don't call XD_DEBUG_MESSAGE with "%f" if not + appropriate. + (xd_read_message): Return Qnil. Don't signal an error; it is not + useful during event reading. + (Fdbus_register_signal): Signal an error if the check for + FUNCTIONP fails. + (Fdbus_register_method): New function. The implementation is not + complete, the call of the function signals an error therefore. + (Fdbus_unregister_object): New function, renamed from + Fdbus_unregister_signal. The initial check signals an error, if + it the objct is not well formed. + +2007-12-30 Richard Stallman <rms@gnu.org> + + * textprop.c (get_char_property_and_overlay): + Signal error if POSITION is out of range in a buffer. + +2007-12-29 Martin Rudalics <rudalics@gmx.at> + + * w32fns.c (Fx_create_frame): Make copy of frame parameters + because the original parameters are in pure storage now. + 2007-12-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> * xdisp.c (phys_cursor_in_rect_p): Check if cursor is in fringe area.
--- a/src/dbusbind.c Sat Dec 29 02:51:57 2007 +0000 +++ b/src/dbusbind.c Wed Jan 02 04:13:39 2008 +0000 @@ -35,7 +35,8 @@ Lisp_Object Qdbus_call_method; Lisp_Object Qdbus_send_signal; Lisp_Object Qdbus_register_signal; -Lisp_Object Qdbus_unregister_signal; +Lisp_Object Qdbus_register_method; +Lisp_Object Qdbus_unregister_object; /* D-Bus error symbol. */ Lisp_Object Qdbus_error; @@ -65,7 +66,7 @@ /* Raise a Lisp error from a D-Bus ERROR. */ #define XD_ERROR(error) \ - { \ + do { \ char s[1024]; \ strcpy (s, error.message); \ dbus_error_free (&error); \ @@ -73,33 +74,37 @@ if (strchr (s, '\n') != NULL) \ s[strlen (s) - 1] = '\0'; \ xsignal1 (Qdbus_error, build_string (s)); \ - } + } while (0) /* Macros for debugging. In order to enable them, build with - "make MYCPPFLAGS='-DDBUS_DEBUG'". */ + "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */ #ifdef DBUS_DEBUG #define XD_DEBUG_MESSAGE(...) \ - { \ + do { \ char s[1024]; \ sprintf (s, __VA_ARGS__); \ printf ("%s: %s\n", __func__, s); \ message ("%s: %s", __func__, s); \ - } + } while (0) #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \ - if (!valid_lisp_object_p (object)) \ - { \ - XD_DEBUG_MESSAGE ("%s Assertion failure", __LINE__); \ - xsignal1 (Qdbus_error, build_string ("Assertion failure")); \ - } + do { \ + if (!valid_lisp_object_p (object)) \ + { \ + XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \ + xsignal1 (Qdbus_error, build_string ("Assertion failure")); \ + } \ + } while (0) #else /* !DBUS_DEBUG */ -#define XD_DEBUG_MESSAGE(...) \ - if (!NILP (Vdbus_debug)) \ - { \ - char s[1024]; \ - sprintf (s, __VA_ARGS__); \ - message ("%s: %s", __func__, s); \ - } +#define XD_DEBUG_MESSAGE(...) \ + do { \ + if (!NILP (Vdbus_debug)) \ + { \ + char s[1024]; \ + sprintf (s, __VA_ARGS__); \ + message ("%s: %s", __func__, s); \ + } \ + } while (0) #define XD_DEBUG_VALID_LISP_OBJECT_P(object) #endif @@ -250,7 +255,7 @@ wrong_type_argument (intern ("D-Bus"), XCAR (XCDR (XD_NEXT_VALUE (elt)))); - sprintf (signature, "%c%s", dtype, x); + sprintf (signature, "%c", dtype); break; case DBUS_TYPE_STRUCT: @@ -328,75 +333,112 @@ Lisp_Object object; DBusMessageIter *iter; { - Lisp_Object elt; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; DBusMessageIter subiter; - char *value; - - XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", object, Qnil))); if (XD_BASIC_DBUS_TYPE (dtype)) - { - switch (dtype) + switch (dtype) + { + case DBUS_TYPE_BYTE: { - case DBUS_TYPE_BYTE: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (unsigned char *) XUINT (object); - break; - - case DBUS_TYPE_BOOLEAN: - XD_DEBUG_MESSAGE ("%c %s", dtype, (NILP (object)) ? "false" : "true"); - value = (NILP (object)) - ? (unsigned char *) FALSE : (unsigned char *) TRUE; - break; - - case DBUS_TYPE_INT16: - XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); - value = (char *) (dbus_int16_t *) XINT (object); - break; - - case DBUS_TYPE_UINT16: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (char *) (dbus_uint16_t *) XUINT (object); - break; + unsigned int val = XUINT (object) & 0xFF; + XD_DEBUG_MESSAGE ("%c %d", dtype, val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } - case DBUS_TYPE_INT32: - XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); - value = (char *) (dbus_int32_t *) XINT (object); - break; - - case DBUS_TYPE_UINT32: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (char *) (dbus_uint32_t *) XUINT (object); - break; - - case DBUS_TYPE_INT64: - XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); - value = (char *) (dbus_int64_t *) XINT (object); - break; + case DBUS_TYPE_BOOLEAN: + { + dbus_bool_t val = (NILP (object)) ? FALSE : TRUE; + XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } - case DBUS_TYPE_UINT64: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (char *) (dbus_int64_t *) XUINT (object); - break; + case DBUS_TYPE_INT16: + { + dbus_int16_t val = XINT (object); + XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } - case DBUS_TYPE_DOUBLE: - XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT (object)); - value = (char *) (float *) XFLOAT (object); - break; - - case DBUS_TYPE_STRING: - case DBUS_TYPE_OBJECT_PATH: - case DBUS_TYPE_SIGNATURE: - XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (object)); - value = SDATA (object); - break; + case DBUS_TYPE_UINT16: + { + dbus_uint16_t val = XUINT (object); + XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; } - if (!dbus_message_iter_append_basic (iter, dtype, &value)) - xsignal2 (Qdbus_error, - build_string ("Unable to append argument"), object); - } + case DBUS_TYPE_INT32: + { + dbus_int32_t val = XINT (object); + XD_DEBUG_MESSAGE ("%c %d", dtype, val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } + + case DBUS_TYPE_UINT32: + { + dbus_uint32_t val = XUINT (object); + XD_DEBUG_MESSAGE ("%c %u", dtype, val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } + + case DBUS_TYPE_INT64: + { + dbus_int64_t val = XINT (object); + XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } + + case DBUS_TYPE_UINT64: + { + dbus_uint64_t val = XUINT (object); + XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } + + case DBUS_TYPE_DOUBLE: + XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT_DATA (object)); + if (!dbus_message_iter_append_basic (iter, dtype, + &XFLOAT_DATA (object))) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + + case DBUS_TYPE_STRING: + case DBUS_TYPE_OBJECT_PATH: + case DBUS_TYPE_SIGNATURE: + { + char *val = SDATA (object); + XD_DEBUG_MESSAGE ("%c %s", dtype, val); + if (!dbus_message_iter_append_basic (iter, dtype, &val)) + xsignal2 (Qdbus_error, + build_string ("Unable to append argument"), object); + return; + } + } else /* Compound types. */ { @@ -470,11 +512,10 @@ switch (dtype) { case DBUS_TYPE_BYTE: - case DBUS_TYPE_INT16: - case DBUS_TYPE_UINT16: { - dbus_uint16_t val; + unsigned int val; dbus_message_iter_get_basic (iter, &val); + val = val & 0xFF; XD_DEBUG_MESSAGE ("%c %d", dtype, val); return make_number (val); } @@ -487,15 +528,21 @@ return (val == FALSE) ? Qnil : Qt; } + case DBUS_TYPE_INT16: + case DBUS_TYPE_UINT16: + { + dbus_uint16_t val; + dbus_message_iter_get_basic (iter, &val); + XD_DEBUG_MESSAGE ("%c %d", dtype, val); + return make_number (val); + } + case DBUS_TYPE_INT32: case DBUS_TYPE_UINT32: { dbus_uint32_t val; dbus_message_iter_get_basic (iter, &val); - if (FIXNUM_OVERFLOW_P (val)) - XD_DEBUG_MESSAGE ("%c %f", dtype, val) - else - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + XD_DEBUG_MESSAGE ("%c %d", dtype, val); return make_fixnum_or_float (val); } @@ -504,10 +551,7 @@ { dbus_uint64_t val; dbus_message_iter_get_basic (iter, &val); - if (FIXNUM_OVERFLOW_P (val)) - XD_DEBUG_MESSAGE ("%c %f", dtype, val) - else - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); return make_fixnum_or_float (val); } @@ -918,11 +962,12 @@ { Lisp_Object args, key, value; struct gcpro gcpro1; - static struct input_event event; + struct input_event event; DBusConnection *connection; DBusMessage *dmessage; DBusMessageIter iter; unsigned int dtype; + int mtype; char uname[DBUS_MAXIMUM_NAME_LENGTH]; char path[DBUS_MAXIMUM_MATCH_RULE_LENGTH]; /* Unlimited in D-Bus spec. */ char interface[DBUS_MAXIMUM_NAME_LENGTH]; @@ -937,38 +982,37 @@ /* Return if there is no queued message. */ if (dmessage == NULL) - return; - - XD_DEBUG_MESSAGE ("Event received"); + return Qnil; /* Collect the parameters. */ args = Qnil; GCPRO1 (args); - if (!dbus_message_iter_init (dmessage, &iter)) + /* Loop over the resulting parameters. Construct a list. */ + if (dbus_message_iter_init (dmessage, &iter)) { - UNGCPRO; - XD_DEBUG_MESSAGE ("Cannot read event"); - return; + while ((dtype = dbus_message_iter_get_arg_type (&iter)) + != DBUS_TYPE_INVALID) + { + args = Fcons (xd_retrieve_arg (dtype, &iter), args); + dbus_message_iter_next (&iter); + } + /* The arguments are stored in reverse order. Reorder them. */ + args = Fnreverse (args); } - /* Loop over the resulting parameters. Construct a list. */ - while ((dtype = dbus_message_iter_get_arg_type (&iter)) != DBUS_TYPE_INVALID) - { - args = Fcons (xd_retrieve_arg (dtype, &iter), args); - dbus_message_iter_next (&iter); - } - - /* The arguments are stored in reverse order. Reorder them. */ - args = Fnreverse (args); - - /* Read unique name, object path, interface and member from the - message. */ + /* Read message type, unique name, object path, interface and member + from the message. */ + mtype = dbus_message_get_type (dmessage); strcpy (uname, dbus_message_get_sender (dmessage)); strcpy (path, dbus_message_get_path (dmessage)); strcpy (interface, dbus_message_get_interface (dmessage)); strcpy (member, dbus_message_get_member (dmessage)); + XD_DEBUG_MESSAGE ("Event received: %d %s %s %s %s %s", + mtype, uname, path, interface, member, + SDATA (format2 ("%s", args, Qnil))); + /* Search for a registered function of the message. */ key = list3 (bus, build_string (interface), build_string (member)); value = Fgethash (key, Vdbus_registered_functions_table, Qnil); @@ -1013,7 +1057,7 @@ /* Cleanup. */ dbus_message_unref (dmessage); - UNGCPRO; + RETURN_UNGCPRO (Qnil); } /* Read queued incoming messages from the system and session buses. */ @@ -1064,11 +1108,11 @@ ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler)) `dbus-register-signal' returns an object, which can be used in -`dbus-unregister-signal' for removing the registration. */) +`dbus-unregister-object' for removing the registration. */) (bus, service, path, interface, signal, handler) Lisp_Object bus, service, path, interface, signal, handler; { - Lisp_Object uname, key, value; + Lisp_Object uname, key, key1, value; DBusConnection *connection; char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH]; DBusError derror; @@ -1079,7 +1123,8 @@ if (!NILP (path)) CHECK_STRING (path); CHECK_STRING (interface); CHECK_STRING (signal); - FUNCTIONP (handler); + if (!FUNCTIONP (handler)) + wrong_type_argument (intern ("functionp"), handler); /* Retrieve unique name of service. If service is a known name, we will register for the corresponding unique name, if any. Signals @@ -1130,21 +1175,84 @@ /* Create a hash table entry. */ key = list3 (bus, interface, signal); + key1 = list4 (uname, service, path, handler); value = Fgethash (key, Vdbus_registered_functions_table, Qnil); - if (NILP (Fmember (list4 (uname, service, path, handler), value))) - Fputhash (key, - Fcons (list4 (uname, service, path, handler), value), - Vdbus_registered_functions_table); + if (NILP (Fmember (key1, value))) + Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table); /* Return object. */ return list2 (key, list3 (service, path, handler)); } -DEFUN ("dbus-unregister-signal", Fdbus_unregister_signal, Sdbus_unregister_signal, +DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method, + 6, 6, 0, + doc: /* Register for method METHOD on the D-Bus BUS. + +BUS is either the symbol `:system' or the symbol `:session'. + +SERVICE is the D-Bus service name of the D-Bus object METHOD is +registered for. It must be a known name. + +PATH is the D-Bus object path SERVICE is registered. INTERFACE is the +interface offered by SERVICE. It must provide METHOD. HANDLER is a +Lisp function to be called when a method call is received. It must +accept the input arguments of METHOD. The return value of HANDLER is +used for composing the returning D-Bus message. + +The function is not fully implemented and documented. Don't use it. */) + (bus, service, path, interface, method, handler) + Lisp_Object bus, service, path, interface, method, handler; +{ + Lisp_Object key, key1, value; + DBusConnection *connection; + int result; + DBusError derror; + + if (NILP (Vdbus_debug)) + xsignal1 (Qdbus_error, build_string ("Not implemented yet")); + + /* Check parameters. */ + CHECK_SYMBOL (bus); + CHECK_STRING (service); + CHECK_STRING (path); + CHECK_STRING (interface); + CHECK_STRING (method); + if (!FUNCTIONP (handler)) + wrong_type_argument (intern ("functionp"), handler); + /* TODO: We must check for a valid service name, otherwise there is + a segmentation fault. */ + + /* Open a connection to the bus. */ + connection = xd_initialize (bus); + + /* Request the known name from the bus. We can ignore the result, + it is set to -1 if there is an error - kind of redundancy. */ + dbus_error_init (&derror); + result = dbus_bus_request_name (connection, SDATA (service), 0, &derror); + if (dbus_error_is_set (&derror)) + XD_ERROR (derror); + + /* Create a hash table entry. */ + key = list3 (bus, interface, method); + key1 = list4 (Qnil, service, path, handler); + value = Fgethash (key, Vdbus_registered_functions_table, Qnil); + + /* We use nil for the unique name, because the method might be + called from everybody. */ + if (NILP (Fmember (key1, value))) + Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table); + + /* Return object. */ + return list2 (key, list3 (service, path, handler)); +} + +DEFUN ("dbus-unregister-object", Fdbus_unregister_object, Sdbus_unregister_object, 1, 1, 0, doc: /* Unregister OBJECT from the D-Bus. -OBJECT must be the result of a preceding `dbus-register-signal' call. */) +OBJECT must be the result of a preceding `dbus-register-signal' or +`dbus-register-method' call. It returns t if OBJECT has been +unregistered, nil otherwise. */) (object) Lisp_Object object; { @@ -1152,7 +1260,8 @@ struct gcpro gcpro1; /* Check parameter. */ - CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object)); + if (!(CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object)))) + wrong_type_argument (intern ("D-Bus"), object); /* Find the corresponding entry in the hash table. */ value = Fgethash (XCAR (object), Vdbus_registered_functions_table, Qnil); @@ -1205,9 +1314,13 @@ staticpro (&Qdbus_register_signal); defsubr (&Sdbus_register_signal); - Qdbus_unregister_signal = intern ("dbus-unregister-signal"); - staticpro (&Qdbus_unregister_signal); - defsubr (&Sdbus_unregister_signal); + Qdbus_register_method = intern ("dbus-register-method"); + staticpro (&Qdbus_register_method); + defsubr (&Sdbus_register_method); + + Qdbus_unregister_object = intern ("dbus-unregister-object"); + staticpro (&Qdbus_unregister_object); + defsubr (&Sdbus_unregister_object); Qdbus_error = intern ("dbus-error"); staticpro (&Qdbus_error);
--- a/src/textprop.c Sat Dec 29 02:51:57 2007 +0000 +++ b/src/textprop.c Wed Jan 02 04:13:39 2008 +0000 @@ -646,6 +646,10 @@ Lisp_Object *overlay_vec; struct buffer *obuf = current_buffer; + if (XINT (position) < BUF_BEGV (XBUFFER (object)) + || XINT (position) > BUF_ZV (XBUFFER (object))) + xsignal1 (Qargs_out_of_range, position); + set_buffer_temp (XBUFFER (object)); GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
--- a/src/w32fns.c Sat Dec 29 02:51:57 2007 +0000 +++ b/src/w32fns.c Wed Jan 02 04:13:39 2008 +0000 @@ -4269,6 +4269,10 @@ check_w32 (); + /* Make copy of frame parameters because the original is in pure + storage now. */ + parameters = Fcopy_alist (parameters); + /* Use this general default value to start with until we know if this frame has a specified name. */ Vx_resource_name = Vinvocation_name;