+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.
* 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>
@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
+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.
* 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
@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
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
+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):
<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
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
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
(@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
system.chassis.manufacturer = \"COMPAL\"
system.chassis.type = \"Notebook\"
system.firmware.release_date = \"03/19/2005\"
- ..."
+ @dots{}"
@end example
@end defun
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
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
** 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.
+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
* 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>
'(( 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
(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:)"
(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
(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"
(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
(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"
(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:)"
(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"
(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")])
(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")])
(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)
(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
(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)
(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)
(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)
(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"
(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")])
: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
(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"]
"----"
(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)
(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)))
(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:\"."
(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 " ")
(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)))
(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)
(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)
(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
(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)
;;; 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)))
(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
(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))
(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)))
\f
;;; XEmacs compability functions
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
(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))))
(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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
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))
(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.
(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.
(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)
;; 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)))))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
(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.
(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)
(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)
\f
;; ======================================================================
-;; 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)))))))
\f
;; ======================================================================
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
(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.
(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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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/"))
"\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)))
`: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/"))
"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
"\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)))
(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
(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."))
(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 ()
: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\""
: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"
(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)
(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)))
;; 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)
"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)
(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)
(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)
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
(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
(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))
;; 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))))
;;
;; - 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)
(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
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")))
;; 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)
(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
(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))
((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)")
+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.
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;
/* 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); \
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
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:
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. */
{
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);
}
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);
}
{
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);
}
{
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];
/* 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);
/* Cleanup. */
dbus_message_unref (dmessage);
- UNGCPRO;
+ RETURN_UNGCPRO (Qnil);
}
/* Read queued incoming messages from the system and session buses. */
("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;
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
/* 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;
{
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);
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);
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);
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;