diff options
| author | Miles Bader <miles@gnu.org> | 2008-01-02 04:13:39 +0000 |
|---|---|---|
| committer | Miles Bader <miles@gnu.org> | 2008-01-02 04:13:39 +0000 |
| commit | 43a8b8ca5797923a7a9848a513ecc8cfff655e17 (patch) | |
| tree | 1fcd51822e01c6017347954e46b788faa2bf728f | |
| parent | e97d3ec0184763b2479224486e70d23f03bd340f (diff) | |
| parent | aacde24f5cdebc6d7ccb2f50a9d8e413906c4497 (diff) | |
| download | emacs-43a8b8ca5797923a7a9848a513ecc8cfff655e17.tar.gz | |
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-308
36 files changed, 1219 insertions, 450 deletions
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index e950d152a80..075f154b56c 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -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> diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi index a9109de667b..7d4f698ee18 100644 --- a/doc/emacs/glossary.texi +++ b/doc/emacs/glossary.texi @@ -1082,7 +1082,7 @@ The selected frame is the one your input currently operates on. @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 diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 50399b0120e..9f98547e590 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -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. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index cdd627f6b52..aef7e4d9a43 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -954,7 +954,8 @@ the current Emacs session. If a symbol has not yet been so used, * 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 @@ must be the last element of the list. For example, @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 @@ to the window text area, otherwise they are relative to 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 diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index a007f4da3a8..4db888d6e44 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -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): diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 352e57f0faa..d8f2f590360 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -197,13 +197,13 @@ format. Example: <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 @@ types are represented by the type symbols @code{:byte}, 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 @@ contain only a key-value pair of two element, with a basic type key. 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 @@ The signal @code{PropertyModified}, discussed as example in (@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 @@ emulate the @code{lshal} command on GNU/Linux systems: system.chassis.manufacturer = \"COMPAL\" system.chassis.type = \"Notebook\" system.firmware.release_date = \"03/19/2005\" - ..." + @dots{}" @end example @end defun @@ -548,13 +554,15 @@ machine, when registered for signal @code{DeviceAdded}, will show you 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 @@ Returns the member name of of the D-Bus object @var{event} is coming 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 @@ -470,6 +470,9 @@ the specified files). ** 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. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7c3655b3044..f3b62b87e10 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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> diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 3c7a22b5ff0..1fff29ccb86 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1759,6 +1759,8 @@ order to Calc's." '(( 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 diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index dd9ec9a2542..ca67b65abfa 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -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"] "----" diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index a7c4b20e30d..ac1c0cd0080 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -491,9 +491,14 @@ If EXPR is nil, return nil." (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) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index b9e462ec05f..b46981f137b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1395,7 +1395,7 @@ that are not customizable options, as well as faces and groups (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 PREFIX first if non-nil." (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 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (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 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (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 @@ Optional EVENT is the location for the menu." (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 @@ Optional EVENT is the location for the menu." (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 @@ Optional EVENT is the location for the menu." (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 @@ restoring it to the state of a face that has never been customized." (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 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;;; 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))) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 92274dcbe21..dfc5babec84 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -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 @@ FACE's list property `theme-face' \(using `custom-push-theme')." (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)) diff --git a/lisp/custom.el b/lisp/custom.el index bbee71ecf1f..d39bbb37e07 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1176,9 +1176,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE." (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 diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index c4ba3e4ca9c..0ef9cc89ba4 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -596,20 +596,39 @@ displayed." 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 @@ displayed." (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)))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 968a115c5d1..61a6f52f55b 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -541,14 +541,14 @@ argument BUFFER-NAME is nil, it defaults to *Colors*." (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)) diff --git a/lisp/faces.el b/lisp/faces.el index 75fe47022a2..11d9ba7b8eb 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -276,10 +276,8 @@ The optional argument FRAME is ignored." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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 the optional argument FRAME is given, report on face FACE in that frame. 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 @@ FRAME nil or not specified means do it for all frames." (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 @@ If SPEC is nil, return nil." (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))) - (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)))) - (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. +(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)))) - ;; Set each frame according to the rules implied by SPEC. + ;; Reset each frame according to the rules implied by all its specs. (dolist (frame (frame-list)) - (face-spec-set face spec frame)))) - + (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)))) + (when attribute + (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 @@ according to the `background-mode' and `display-type' frame parameters." (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 @@ according to the `background-mode' and `display-type' frame parameters." ;; 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 @@ Initialize colors of certain faces from frame parameters." (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)) diff --git a/lisp/files.el b/lisp/files.el index dec47ce362e..75dfb089c51 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -635,10 +635,10 @@ Directories are separated by occurrences of `path-separator' (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. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index f7cc4da0aae..147b98f5a55 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1303,6 +1303,12 @@ Optional argument OBJECT is the string or buffer containing the text." (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 @@ Optional argument OBJECT is the string or buffer containing the text." (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) diff --git a/lisp/man.el b/lisp/man.el index 48639cd764b..1f4288bc803 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -642,50 +642,91 @@ a new value." ;; ====================================================================== -;; 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))))))) ;; ====================================================================== diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 75bcb8ed138..1c1016aed97 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -64,33 +64,50 @@ hash table." 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 @@ part of the event, is called with arguments ARGS." (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. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index a1a0e0ca8e9..06e5c1ad678 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1480,32 +1480,47 @@ record activity." (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) diff --git a/lisp/startup.el b/lisp/startup.el index 3483e158429..8ab50efa877 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1157,7 +1157,7 @@ regardless of the value of this variable." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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 @@ regardless of the value of this variable." "\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 @@ Each element in the list should be a list of strings or pairs `: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 @@ Each element in the list should be a list of strings or pairs "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 @@ Each element in the list should be a list of strings or pairs "\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 @@ a face or button specification." (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 @@ a face or button specification." (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 @@ a face or button specification." (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 () diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0e3f9dffada..65153c3bb5d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -336,12 +336,17 @@ Always stores Fcc copy of message when nil." :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\"" diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 395145fd53b..5728497ed6c 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -93,6 +93,10 @@ When it reaches that size (in bytes), a warning is sent." :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" diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index 01599c91dff..8a1c56490ac 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -522,7 +522,7 @@ Optional argument LOCALP is always ignored." (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) diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index c3aff66588b..321f4e52805 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -947,6 +947,7 @@ is non-nil." (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 @@ is non-nil." ;; 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) diff --git a/lisp/vc-git.el b/lisp/vc-git.el index 7895251be0e..64bcbeb0b2b 100644 --- a/lisp/vc-git.el +++ b/lisp/vc-git.el @@ -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) diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index 41cc883c0a4..dd8cccb724b 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -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) diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 3d589e117c8..39550da8018 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -503,14 +503,16 @@ For registered files, the value returned is one of: 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 diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index ced4c941b55..385260b3d87 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -366,6 +366,30 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (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 @@ information about FILENAME and return its status." (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 @@ information about FILENAME and return its status." ;; 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)))) diff --git a/lisp/vc.el b/lisp/vc.el index 5ec872523b5..ddcb53a0cb6 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -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 @@ NOT-URGENT means it is ok to continue if the user says not to save." (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 @@ merge in the changes into your working copy." 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 @@ merge in the changes into your working copy." ;; 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 @@ Called by dired after any portion of a vc-dired buffer has been read in." (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 @@ Called by dired after any portion of a vc-dired buffer has been read in." (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 @@ to provide the `find-revision' operation instead." ((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)") diff --git a/src/ChangeLog b/src/ChangeLog index aca22996d14..b3fddb33219 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -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. diff --git a/src/dbusbind.c b/src/dbusbind.c index 88f2ccdb3eb..57625d3876e 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -35,7 +35,8 @@ Lisp_Object Qdbus_get_unique_name; 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 @@ Lisp_Object Vdbus_debug; /* 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 @@ Lisp_Object Vdbus_debug; 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 @@ xd_signature(signature, dtype, parent_type, object) 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 @@ xd_append_arg (dtype, object, iter) 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; + 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_UINT16: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (char *) (dbus_uint16_t *) XUINT (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_INT32: - XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); - value = (char *) (dbus_int32_t *) XINT (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_UINT32: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (char *) (dbus_uint32_t *) XUINT (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; + } - case DBUS_TYPE_INT64: - XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); - value = (char *) (dbus_int64_t *) XINT (object); - break; + 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_UINT64: - XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); - value = (char *) (dbus_int64_t *) XUINT (object); - break; + 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_DOUBLE: - XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT (object)); - value = (char *) (float *) XFLOAT (object); - break; + 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_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_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; } - if (!dbus_message_iter_append_basic (iter, dtype, &value)) - xsignal2 (Qdbus_error, - build_string ("Unable to append argument"), object); - } + 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 @@ xd_retrieve_arg (dtype, iter) 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 @@ xd_retrieve_arg (dtype, iter) 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 @@ xd_retrieve_arg (dtype, iter) { 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 @@ xd_read_message (bus) { 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 @@ xd_read_message (bus) /* 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)) - { - UNGCPRO; - XD_DEBUG_MESSAGE ("Cannot read event"); - return; - } - /* Loop over the resulting parameters. Construct a list. */ - while ((dtype = dbus_message_iter_get_arg_type (&iter)) != DBUS_TYPE_INVALID) + if (dbus_message_iter_init (dmessage, &iter)) { - args = Fcons (xd_retrieve_arg (dtype, &iter), args); - dbus_message_iter_next (&iter); + 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); } - /* 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 @@ xd_read_message (bus) /* Cleanup. */ dbus_message_unref (dmessage); - UNGCPRO; + RETURN_UNGCPRO (Qnil); } /* Read queued incoming messages from the system and session buses. */ @@ -1064,11 +1108,11 @@ SIGNAL and HANDLER must not be nil. Example: ("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 @@ SIGNAL and HANDLER must not be nil. Example: 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 @@ SIGNAL and HANDLER must not be nil. Example: /* 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 (key1, value))) + Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table); + + /* Return object. */ + return list2 (key, list3 (service, path, handler)); +} + +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); - if (NILP (Fmember (list4 (uname, service, path, handler), value))) - Fputhash (key, - Fcons (list4 (uname, service, path, handler), value), - Vdbus_registered_functions_table); + /* 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-signal", Fdbus_unregister_signal, Sdbus_unregister_signal, +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 @@ OBJECT must be the result of a preceding `dbus-register-signal' call. */) 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 @@ syms_of_dbusbind () 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); diff --git a/src/textprop.c b/src/textprop.c index f7b50755ed1..6c1470735bd 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -646,6 +646,10 @@ get_char_property_and_overlay (position, prop, object, overlay) 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); diff --git a/src/w32fns.c b/src/w32fns.c index 8b2b865c6d3..74629225cbf 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4269,6 +4269,10 @@ This function is an internal primitive--use `make-frame' instead. */) 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; |