aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2008-01-02 04:13:39 +0000
committerMiles Bader2008-01-02 04:13:39 +0000
commit43a8b8ca5797923a7a9848a513ecc8cfff655e17 (patch)
tree1fcd51822e01c6017347954e46b788faa2bf728f
parente97d3ec0184763b2479224486e70d23f03bd340f (diff)
parentaacde24f5cdebc6d7ccb2f50a9d8e413906c4497 (diff)
downloademacs-43a8b8ca5797923a7a9848a513ecc8cfff655e17.tar.gz
emacs-43a8b8ca5797923a7a9848a513ecc8cfff655e17.zip
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-308
-rw-r--r--doc/emacs/ChangeLog6
-rw-r--r--doc/emacs/glossary.texi2
-rw-r--r--doc/lispref/ChangeLog5
-rw-r--r--doc/lispref/commands.texi11
-rw-r--r--doc/misc/ChangeLog9
-rw-r--r--doc/misc/dbus.texi34
-rw-r--r--etc/NEWS3
-rw-r--r--lisp/ChangeLog153
-rw-r--r--lisp/calc/calc-lang.el2
-rw-r--r--lisp/calc/calc-menu.el358
-rw-r--r--lisp/calc/calc-units.el11
-rw-r--r--lisp/cus-edit.el60
-rw-r--r--lisp/cus-face.el5
-rw-r--r--lisp/custom.el4
-rw-r--r--lisp/emacs-lisp/elp.el50
-rw-r--r--lisp/facemenu.el4
-rw-r--r--lisp/faces.el140
-rw-r--r--lisp/files.el8
-rw-r--r--lisp/font-lock.el12
-rw-r--r--lisp/man.el103
-rw-r--r--lisp/net/dbus.el63
-rw-r--r--lisp/net/rcirc.el53
-rw-r--r--lisp/startup.el27
-rw-r--r--lisp/textmodes/ispell.el9
-rw-r--r--lisp/thumbs.el4
-rw-r--r--lisp/vc-bzr.el2
-rw-r--r--lisp/vc-cvs.el2
-rw-r--r--lisp/vc-git.el10
-rw-r--r--lisp/vc-hg.el20
-rw-r--r--lisp/vc-hooks.el6
-rw-r--r--lisp/vc-svn.el37
-rw-r--r--lisp/vc.el61
-rw-r--r--src/ChangeLog38
-rw-r--r--src/dbusbind.c349
-rw-r--r--src/textprop.c4
-rw-r--r--src/w32fns.c4
36 files changed, 1219 insertions, 450 deletions
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index e950d152a80..075f154b56c 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,7 @@
12007-12-31 Martin Rudalics <rudalics@gmx.at>
2
3 * glossary.texi (Glossary): Fix typo.
4
12007-12-27 Richard Stallman <rms@gnu.org> 52007-12-27 Richard Stallman <rms@gnu.org>
2 6
3 * text.texi (Formatted Text): Improve menu tag. 7 * text.texi (Formatted Text): Improve menu tag.
@@ -12,7 +16,7 @@
12 16
13 * search.texi (Query Replace): Make exp of query-replace more 17 * search.texi (Query Replace): Make exp of query-replace more
14 self-contained, and clarify. 18 self-contained, and clarify.
15 19
16 * cc-mode.texi (Getting Started): Change @ref to @pxref. 20 * cc-mode.texi (Getting Started): Change @ref to @pxref.
17 21
182007-12-15 Richard Stallman <rms@gnu.org> 222007-12-15 Richard Stallman <rms@gnu.org>
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index a9109de667b..7d4f698ee18 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -1082,7 +1082,7 @@ The selected frame is the one your input currently operates on.
1082@xref{Frames}. 1082@xref{Frames}.
1083 1083
1084@item Selected Window 1084@item Selected Window
1085The selected frame is the one your input currently operates on. 1085The selected window is the one your input currently operates on.
1086@xref{Basic Window}. 1086@xref{Basic Window}.
1087 1087
1088@item Selecting a Buffer 1088@item Selecting a Buffer
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 50399b0120e..9f98547e590 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
12007-12-30 Richard Stallman <rms@gnu.org>
2
3 * commands.texi (Accessing Mouse): Renamed from Accessing Events.
4 (Accessing Scroll): New node broken out of Accessing Mouse.
5
12007-12-28 Richard Stallman <rms@gnu.org> 62007-12-28 Richard Stallman <rms@gnu.org>
2 7
3 * frames.texi (Size Parameters): Fix typo. 8 * frames.texi (Size Parameters): Fix typo.
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index cdd627f6b52..aef7e4d9a43 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -954,7 +954,8 @@ the current Emacs session. If a symbol has not yet been so used,
954* Event Examples:: Examples of the lists for mouse events. 954* Event Examples:: Examples of the lists for mouse events.
955* Classifying Events:: Finding the modifier keys in an event symbol. 955* Classifying Events:: Finding the modifier keys in an event symbol.
956 Event types. 956 Event types.
957* Accessing Events:: Functions to extract info from events. 957* Accessing Mouse:: Functions to extract info from mouse events.
958* Accessing Scroll:: Functions to get info from scroll bar events.
958* Strings of Events:: Special considerations for putting 959* Strings of Events:: Special considerations for putting
959 keyboard character events in a string. 960 keyboard character events in a string.
960@end menu 961@end menu
@@ -1810,8 +1811,8 @@ must be the last element of the list. For example,
1810@end example 1811@end example
1811@end defun 1812@end defun
1812 1813
1813@node Accessing Events 1814@node Accessing Mouse
1814@subsection Accessing Events 1815@subsection Accessing Mouse Events
1815@cindex mouse events, data in 1816@cindex mouse events, data in
1816 1817
1817 This section describes convenient functions for accessing the data in 1818 This section describes convenient functions for accessing the data in
@@ -1957,6 +1958,10 @@ to the window text area, otherwise they are relative to
1957the entire window area including scroll bars, margins and fringes. 1958the entire window area including scroll bars, margins and fringes.
1958@end defun 1959@end defun
1959 1960
1961@node Accessing Scroll
1962@subsection Accessing Scroll Bar Events
1963@cindex scroll bar events, data in
1964
1960 These functions are useful for decoding scroll bar events. 1965 These functions are useful for decoding scroll bar events.
1961 1966
1962@defun scroll-bar-event-ratio event 1967@defun scroll-bar-event-ratio event
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index a007f4da3a8..4db888d6e44 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,12 @@
12007-12-30 Michael Albinus <michael.albinus@gmx.de>
2
3 * dbus.texi (all): Replace "..." by @dots{}.
4 (Type Conversion): Precise the value range for :byte types.
5 (Signals): Rename dbus-unregister-signal to dbus-unregister-object.
6 Mention its return value.
7 (Errors and Events): There is no D-Bus error propagation during event
8 processing.
9
12007-12-29 Jay Belanger <jay.p.belanger@gmail.com> 102007-12-29 Jay Belanger <jay.p.belanger@gmail.com>
2 11
3 * calc.tex (Yacas Language, Maxima Language, Giac Language): 12 * calc.tex (Yacas Language, Maxima Language, Giac Language):
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 352e57f0faa..d8f2f590360 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -197,13 +197,13 @@ format. Example:
197 <method name=\"GetAllProperties\"> 197 <method name=\"GetAllProperties\">
198 <arg name=\"properties\" direction=\"out\" type=\"a@{sv@}\"/> 198 <arg name=\"properties\" direction=\"out\" type=\"a@{sv@}\"/>
199 </method> 199 </method>
200 ... 200 @dots{}
201 <signal name=\"PropertyModified\"> 201 <signal name=\"PropertyModified\">
202 <arg name=\"num_updates\" type=\"i\"/> 202 <arg name=\"num_updates\" type=\"i\"/>
203 <arg name=\"updates\" type=\"a(sbb)\"/> 203 <arg name=\"updates\" type=\"a(sbb)\"/>
204 </signal> 204 </signal>
205 </interface> 205 </interface>
206 ... 206 @dots{}
207 </node>" 207 </node>"
208@end example 208@end example
209 209
@@ -277,21 +277,27 @@ types are represented by the type symbols @code{:byte},
277Example: 277Example:
278 278
279@lisp 279@lisp
280(dbus-call-method ... @var{NUMBER} @var{STRING}) 280(dbus-call-method @dots{} @var{NUMBER} @var{STRING})
281@end lisp 281@end lisp
282 282
283is equivalent to 283is equivalent to
284 284
285@lisp 285@lisp
286(dbus-call-method ... :uint32 @var{NUMBER} :string @var{STRING}) 286(dbus-call-method @dots{} :uint32 @var{NUMBER} :string @var{STRING})
287@end lisp 287@end lisp
288 288
289but different to 289but different to
290 290
291@lisp 291@lisp
292(dbus-call-method ... :int32 @var{NUMBER} :signature @var{STRING}) 292(dbus-call-method @dots{} :int32 @var{NUMBER} :signature @var{STRING})
293@end lisp 293@end lisp
294 294
295The value for a byte type can be any integer in the range 0 through
296255. If a character is used as argument, modifiers represented
297outside this range are stripped of. For example, @code{:byte ?x} is
298equal to @code{:byte ?\M-x}, but it is not equal to @code{:byte
299?\C-x} or @code{:byte ?\M-\C-x}.
300
295A D-Bus compound type is always represented as list. The car of this 301A D-Bus compound type is always represented as list. The car of this
296list can be the type symbol @code{:array}, @code{:variant}, 302list can be the type symbol @code{:array}, @code{:variant},
297@code{:struct} or @code{:dict-entry}, which would result in a 303@code{:struct} or @code{:dict-entry}, which would result in a
@@ -313,7 +319,7 @@ contain only a key-value pair of two element, with a basic type key.
313Example: 319Example:
314 320
315@lisp 321@lisp
316(dbus-send-signal ... 322(dbus-send-signal @dots{}
317 :object-path STRING '(:variant :boolean BOOL) 323 :object-path STRING '(:variant :boolean BOOL)
318 '(:array NUMBER NUMBER) '(:array BOOL :boolean BOOL) 324 '(:array NUMBER NUMBER) '(:array BOOL :boolean BOOL)
319 '(:struct BOOL :boolean BOOL BOOL 325 '(:struct BOOL :boolean BOOL BOOL
@@ -365,7 +371,7 @@ The signal @code{PropertyModified}, discussed as example in
365(@var{BOOL} stands here for either @code{nil} or @code{t}): 371(@var{BOOL} stands here for either @code{nil} or @code{t}):
366 372
367@lisp 373@lisp
368(@var{NUMBER} ((@var{STRING} @var{BOOL} @var{BOOL}) (@var{STRING} @var{BOOL} @var{BOOL}) ...)) 374(@var{NUMBER} ((@var{STRING} @var{BOOL} @var{BOOL}) (@var{STRING} @var{BOOL} @var{BOOL}) @dots{}))
369@end lisp 375@end lisp
370 376
371 377
@@ -460,7 +466,7 @@ emulate the @code{lshal} command on GNU/Linux systems:
460 system.chassis.manufacturer = \"COMPAL\" 466 system.chassis.manufacturer = \"COMPAL\"
461 system.chassis.type = \"Notebook\" 467 system.chassis.type = \"Notebook\"
462 system.firmware.release_date = \"03/19/2005\" 468 system.firmware.release_date = \"03/19/2005\"
463 ..." 469 @dots{}"
464@end example 470@end example
465@end defun 471@end defun
466 472
@@ -548,13 +554,15 @@ machine, when registered for signal @code{DeviceAdded}, will show you
548which objects the GNU/Linux @code{hal} daemon adds. 554which objects the GNU/Linux @code{hal} daemon adds.
549 555
550@code{dbus-register-signal} returns a Lisp symbol, which can be used 556@code{dbus-register-signal} returns a Lisp symbol, which can be used
551as argument in @code{dbus-unregister-signal} for removing the 557as argument in @code{dbus-unregister-object} for removing the
552registration for @var{signal}. 558registration for @var{signal}.
553@end defun 559@end defun
554 560
555@defun dbus-unregister-signal object 561@defun dbus-unregister-object object
556Unregister @var{object} from the the D-Bus. @var{object} must be the 562Unregister @var{object} from the the D-Bus. @var{object} must be the
557result of a preceding @code{dbus-register-signal} call. 563result of a preceding @code{dbus-register-signal} or
564@code{dbus-register-method} call. It returns @code{t} if @var{object}
565has been unregistered, @code{nil} otherwise.
558@end defun 566@end defun
559 567
560 568
@@ -624,6 +632,10 @@ Returns the member name of of the D-Bus object @var{event} is coming
624from. It is either a signal name or a method name. 632from. It is either a signal name or a method name.
625@end defun 633@end defun
626 634
635D-Bus errors are not propagated during event handling, because it is
636usually not desired. D-Bus errors in events can be made visible by
637setting the variable @code{dbus-debug} to @code{t}.
638
627 639
628@node GNU Free Documentation License 640@node GNU Free Documentation License
629@appendix GNU Free Documentation License 641@appendix GNU Free Documentation License
diff --git a/etc/NEWS b/etc/NEWS
index c71fb2ae349..90cc3efaf8d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -470,6 +470,9 @@ the specified files).
470 470
471** The new function `read-color' reads a color name using the minibuffer. 471** The new function `read-color' reads a color name using the minibuffer.
472 472
473** The new function `face-all-attributes' returns an alist
474describing all the basic attributes of a given face.
475
473** `interprogram-paste-function' can now return one string or a list 476** `interprogram-paste-function' can now return one string or a list
474of strings. In the latter case, Emacs puts the second and following 477of strings. In the latter case, Emacs puts the second and following
475strings on the kill ring. 478strings on the kill ring.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7c3655b3044..f3b62b87e10 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,152 @@
12008-01-02 Miles Bader <Miles Bader <miles@gnu.org>>
2
3 * net/rcirc.el (rcirc-log-filename-function): New variable.
4 (rcirc-log): Use `rcirc-log-filename-function' to generate the
5 log-file name. Don't log anything if it returns nil.
6 (rcirc-log-write): Use `expand-file-name' when merging the
7 log-file name from the alist with rcirc-log-directory; this does
8 the right thing if the name in the alist already an absolute
9 filename. Make the log-file directory if necessary.
10
112007-12-29 Richard Stallman <rms@gnu.org>
12
13 * font-lock.el (font-lock-prepend-text-property)
14 (font-lock-append-text-property): Canonicalize the face and
15 font-lock-face properties.
16
17 * faces.el (facep): Doc fix.
18
19 * startup.el (fancy-startup-tail, fancy-about-text)
20 (fancy-startup-text): Regularize format of face property.
21
22 * facemenu.el (list-colors-print): Use :background and :foreground
23 instead of background-color and foreground-color.
24
252007-12-29 Drew Adams <drew.adams@oracle.com>
26
27 * cus-edit.el (custom-add-parent-links):
28 Fill the "Parent documentation" text.
29
302007-12-29 Eli Zaretskii <eliz@gnu.org>
31
32 * textmodes/ispell.el (ispell-grep-command): Use "grep" on
33 MS-Windows and MS-DOS.
34 (ispell-grep-options): Use "-Ei" on MS-Windows and MS-DOS.
35
362008-01-02 Eric S. Raymond <esr@snark.thyrsus.com>
37
38 * vc-svn.el (vc-svn-modify-change comment): New function.
39
402008-01-01 Dan Nicolaescu <dann@ics.uci.edu>
41
42 * vc-git.el (vc-git-dir-state): Set the vc-backend property. Do
43 not disable undo, with-temp-buffer does it by default.
44
452008-01-01 Eric S. Raymond <esr@snark.thyrsus.com>
46
47 * vc-svn.el (vc-svn-parse-status): Set the 'unregisted property
48 correctly.
49
50 * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call
51 with vc-state.
52 (vc-next-action): Fix vc-transfer-file call.
53
542007-12-31 Tom Tromey <tromey@redhat.com>
55
56 * emacs-lisp/elp.el (elp-results): Use header-line-format for
57 header. Move point to the start of the buffer.
58
592007-12-31 Dan Nicolaescu <dann@ics.uci.edu>
60
61 * vc-cvs.el (vc-cvs-parse-entry): Set the vc-backend property.
62
63 * vc.el: State that dir-state is required to set the vc-state and
64 vc-backend properties.
65
662007-12-31 Martin Rudalics <rudalics@gmx.at>
67
68 * man.el (Man-default-man-entry): Make this a defun. Improve
69 guessing mechanism and handling of section numbers.
70
712007-12-31 Richard Stallman <rms@gnu.org>
72
73 * faces.el (face-all-attributes): If FRAME is nil, return defaults.
74
752007-12-31 Jay Belanger <jay.p.belanger@gmail.com>
76
77 * calc/calc-units.el (calc-convert-temperature): Ensure that units
78 are on the result even when the result is zero.
79
802007-12-30 Michael Albinus <michael.albinus@gmx.de>
81
82 * net/dbus.el (dbus-name-owner-changed-handler): Make the function
83 resistent towards wrong parameters.
84 (dbus-handle-event): Propagate D-Bus errors only in the debug case.
85
862007-12-30 Richard Stallman <rms@gnu.org>
87
88 * faces.el (face-all-attributes): New function.
89
90 * faces.el (face-differs-from-default-p): Compute list of attr names
91 from face-attribute-name-alist.
92
93 * cus-edit.el (custom-face-set): Call `face-spec-set' with FOR-DEFFACE.
94 (custom-face-save): Likewise.
95 (custom-face-reset-saved, custom-face-reset-standard): Likewise.
96
97 * cus-face.el (custom-declare-face): Per frame, use `face-spec-set-2'.
98 (custom-theme-set-faces): Clear `face-override-spec' property.
99 Call `face-spec-set' with FOR-DEFFACE.
100
101 * custom.el (custom-theme-recalc-face):
102 Simply call `face-spec-recalc'.
103
104 * faces.el (face-spec-set): Third arg is now FOR-DEFFACE.
105 Use of frame as third arg is deprecated.
106 Handle `face-override-spec' property.
107 (face-spec-recalc): New function.
108 (face-spec-set-2): New function.
109 (frame-set-background-mode): Handle `face-override-spec' property.
110 Use `face-spec-recalc'.
111 (face-set-after-frame-default): Use `face-spec-recalc'.
112
1132007-12-29 Nick Roberts <nickrob@snap.net.nz>
114
115 * thumbs.el (thumbs-conversion-program): Add comment for Windows XP.
116
1172007-12-29 Dan Nicolaescu <dann@ics.uci.edu>
118
119 * vc-hg.el (vc-hg-dir-state): Set the vc-backend property.
120
1212007-12-29 Eric S. Raymond <esr@snark.thyrsus.com>
122
123 * vc-svn.el (vc-svn-parse-status): Recognize 'unregistered,
124 'added, 'removed.
125
126 * vc.el (header coment): Better description of dir-state.
127 (vc-compatible-state): New function. Checks whether two states
128 can be in the same changeset; used with 'edited it can test whether
129 the next action for a state should be commit.
130 (vc-default-dired-format0info): Display 'added state.
131 (vc-dired-hook): Turn off undo, this is a speed tweak.
132
133 * vc-bzr.el (vc-bzr-dir-state): Recognize 'added.
134
135 * vc-hg.el (vc-bzr-hg-state): Recognize 'added and 'removed.
136 Cope with the possibility that the 'C' status flag might change
137 in 0.9,6.
138
139 * vc-git.el (vc-bzr-dir-state): Recognize 'removed.
140
1412007-12-29 Thien-Thi Nguyen <ttn@gnuvola.org>
142
143 * files.el (cd-absolute): Fix omission bug:
144 Make `list-buffers-directory' buffer-local.
145
1462007-12-29 Dan Nicolaescu <dann@ics.uci.edu>
147
148 * vc-hg.el (vc-hg-dir-state): Deal with the up-to-date state.
149
12007-12-29 Jay Belanger <jay.p.belanger@gmail.com> 1502007-12-29 Jay Belanger <jay.p.belanger@gmail.com>
2 151
3 * calc/calc-aent.el (math-read-token): Fix misplaced 152 * calc/calc-aent.el (math-read-token): Fix misplaced
@@ -29,6 +178,10 @@
29 * calc/calc-help.el (calc-d-prefix-help): Add new languages. 178 * calc/calc-help.el (calc-d-prefix-help): Add new languages.
30 179
31 * calc/calc-menu.el (calc-modes-menu): Add new languages. 180 * calc/calc-menu.el (calc-modes-menu): Add new languages.
181 (calc-arithmetic-menu, calc-scientific-function-menu)
182 (calc-algebra-menu, calc-graphics-menu, calc-vectors-menu)
183 (calc-units-menu, calc-variables-menu, calc-stack-menu):
184 Add :active keywords.
32 185
332007-12-28 Dan Nicolaescu <dann@ics.uci.edu> 1862007-12-28 Dan Nicolaescu <dann@ics.uci.edu>
34 187
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 3c7a22b5ff0..1fff29ccb86 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -1759,6 +1759,8 @@ order to Calc's."
1759 '(( infinity . var-inf) 1759 '(( infinity . var-inf)
1760 ( infinity . var-uinf))) 1760 ( infinity . var-uinf)))
1761 1761
1762(put 'giac 'math-complex-format 'i)
1763
1762(add-to-list 'calc-lang-allow-underscores 'giac) 1764(add-to-list 'calc-lang-allow-underscores 'giac)
1763 1765
1764(put 'giac 'math-compose-subscr 1766(put 'giac 'math-compose-subscr
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index dd9ec9a2542..ca67b65abfa 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -26,46 +26,58 @@
26(defvar calc-arithmetic-menu 26(defvar calc-arithmetic-menu
27 (list "Arithmetic" 27 (list "Arithmetic"
28 (list "Basic" 28 (list "Basic"
29 ["-(1:)" calc-change-sign :keys "n"] 29 ["-(1:)" calc-change-sign
30 ["(2:) + (1:)" calc-plus :keys "+"] 30 :keys "n" :active (>= (calc-stack-size) 1)]
31 ["(2:) - (1:)" calc-minus :keys "-"] 31 ["(2:) + (1:)" calc-plus
32 ["(2:) * (1:)" calc-times :keys "*"] 32 :keys "+" :active (>= (calc-stack-size) 2)]
33 ["(2:) / (1:)" calc-divide :keys "/"] 33 ["(2:) - (1:)" calc-minus
34 ["(2:) ^ (1:)" calc-power :keys "^"] 34 :keys "-" :active (>= (calc-stack-size) 2)]
35 ["(2:) * (1:)" calc-times
36 :keys "*" :active (>= (calc-stack-size) 2)]
37 ["(2:) / (1:)" calc-divide
38 :keys "/" :active (>= (calc-stack-size) 2)]
39 ["(2:) ^ (1:)" calc-power
40 :keys "^" :active (>= (calc-stack-size) 2)]
35 ["(2:) ^ (1/(1:))" 41 ["(2:) ^ (1/(1:))"
36 (progn 42 (progn
37 (require 'calc-ext) 43 (require 'calc-ext)
38 (let ((calc-inverse-flag t)) 44 (let ((calc-inverse-flag t))
39 (call-interactively 'calc-power))) 45 (call-interactively 'calc-power)))
40 :keys "I ^" 46 :keys "I ^"
47 :active (>= (calc-stack-size) 2)
41 :help "The (1:)th root of (2:)"] 48 :help "The (1:)th root of (2:)"]
42 ["abs(1:)" 49 ["abs(1:)"
43 (progn 50 (progn
44 (require 'calc-arith) 51 (require 'calc-arith)
45 (call-interactively 'calc-abs)) 52 (call-interactively 'calc-abs))
46 :keys "A" 53 :keys "A"
54 :active (>= (calc-stack-size) 1)
47 :help "Absolute value"] 55 :help "Absolute value"]
48 ["1/(1:)" 56 ["1/(1:)"
49 (progn 57 (progn
50 (require 'calc-arith) 58 (require 'calc-arith)
51 (call-interactively 'calc-inv)) 59 (call-interactively 'calc-inv))
52 :keys "&"] 60 :keys "&"
61 :active (>= (calc-stack-size) 1)]
53 ["sqrt(1:)" 62 ["sqrt(1:)"
54 (progn 63 (progn
55 (require 'calc-math) 64 (require 'calc-math)
56 (call-interactively 'calc-sqrt)) 65 (call-interactively 'calc-sqrt))
57 :keys "Q"] 66 :keys "Q"
67 :active (>= (calc-stack-size) 1)]
58 ["idiv(2:,1:)" 68 ["idiv(2:,1:)"
59 (progn 69 (progn
60 (require 'calc-arith) 70 (require 'calc-arith)
61 (call-interactively 'calc-idiv)) 71 (call-interactively 'calc-idiv))
62 :keys "\\" 72 :keys "\\"
73 :active (>= (calc-stack-size) 2)
63 :help "The integer quotient of (2:) over (1:)"] 74 :help "The integer quotient of (2:) over (1:)"]
64 ["(2:) mod (1:)" 75 ["(2:) mod (1:)"
65 (progn 76 (progn
66 (require 'calc-misc) 77 (require 'calc-misc)
67 (call-interactively 'calc-mod)) 78 (call-interactively 'calc-mod))
68 :keys "%" 79 :keys "%"
80 :active (>= (calc-stack-size) 2)
69 :help "The remainder when (2:) is divided by (1:)"]) 81 :help "The remainder when (2:) is divided by (1:)"])
70 (list "Rounding" 82 (list "Rounding"
71 ["floor(1:)" 83 ["floor(1:)"
@@ -73,64 +85,75 @@
73 (require 'calc-arith) 85 (require 'calc-arith)
74 (call-interactively 'calc-floor)) 86 (call-interactively 'calc-floor))
75 :keys "F" 87 :keys "F"
88 :active (>= (calc-stack-size) 1)
76 :help "The greatest integer less than or equal to (1:)"] 89 :help "The greatest integer less than or equal to (1:)"]
77 ["ceiling(1:)" 90 ["ceiling(1:)"
78 (progn 91 (progn
79 (require 'calc-arith) 92 (require 'calc-arith)
80 (call-interactively 'calc-ceiling)) 93 (call-interactively 'calc-ceiling))
81 :keys "I F" 94 :keys "I F"
95 :active (>= (calc-stack-size) 1)
82 :help "The smallest integer greater than or equal to (1:)"] 96 :help "The smallest integer greater than or equal to (1:)"]
83 ["round(1:)" 97 ["round(1:)"
84 (progn 98 (progn
85 (require 'calc-arith) 99 (require 'calc-arith)
86 (call-interactively 'calc-round)) 100 (call-interactively 'calc-round))
87 :keys "R" 101 :keys "R"
102 :active (>= (calc-stack-size) 1)
88 :help "The nearest integer to (1:)"] 103 :help "The nearest integer to (1:)"]
89 ["truncate(1:)" 104 ["truncate(1:)"
90 (progn 105 (progn
91 (require 'calc-arith) 106 (require 'calc-arith)
92 (call-interactively 'calc-trunc)) 107 (call-interactively 'calc-trunc))
93 :keys "I R" 108 :keys "I R"
109 :active (>= (calc-stack-size) 1)
94 :help "The integer part of (1:)"]) 110 :help "The integer part of (1:)"])
95 (list "Complex Numbers" 111 (list "Complex Numbers"
96 ["Re(1:)" 112 ["Re(1:)"
97 (progn 113 (progn
98 (require 'calc-cplx) 114 (require 'calc-cplx)
99 (call-interactively 'calc-re)) 115 (call-interactively 'calc-re))
100 :keys "f r"] 116 :keys "f r"
117 :active (>= (calc-stack-size) 1)]
101 ["Im(1:)" 118 ["Im(1:)"
102 (progn 119 (progn
103 (require 'calc-cplx) 120 (require 'calc-cplx)
104 (call-interactively 'calc-im)) 121 (call-interactively 'calc-im))
105 :keys "f i"] 122 :keys "f i"
123 :active (>= (calc-stack-size) 1)]
106 ["conj(1:)" 124 ["conj(1:)"
107 (progn 125 (progn
108 (require 'calc-cplx) 126 (require 'calc-cplx)
109 (call-interactively 'calc-conj)) 127 (call-interactively 'calc-conj))
110 :keys "J" 128 :keys "J"
129 :active (>= (calc-stack-size) 1)
111 :help "The complex conjugate of (1:)"] 130 :help "The complex conjugate of (1:)"]
112 ["length(1:)" 131 ["length(1:)"
113 (progn (require 'calc-arith) 132 (progn (require 'calc-arith)
114 (call-interactively 'calc-abs)) 133 (call-interactively 'calc-abs))
115 :keys "A" 134 :keys "A"
135 :active (>= (calc-stack-size) 1)
116 :help "The length (absolute value) of (1:)"] 136 :help "The length (absolute value) of (1:)"]
117 ["arg(1:)" 137 ["arg(1:)"
118 (progn 138 (progn
119 (require 'calc-cplx) 139 (require 'calc-cplx)
120 (call-interactively 'calc-argument)) 140 (call-interactively 'calc-argument))
121 :keys "G" 141 :keys "G"
142 :active (>= (calc-stack-size) 1)
122 :help "The argument (polar angle) of (1:)"]) 143 :help "The argument (polar angle) of (1:)"])
123 (list "Conversion" 144 (list "Conversion"
124 ["Convert (1:) to a float" 145 ["Convert (1:) to a float"
125 (progn 146 (progn
126 (require 'calc-ext) 147 (require 'calc-ext)
127 (call-interactively 'calc-float)) 148 (call-interactively 'calc-float))
128 :keys "c f"] 149 :keys "c f"
150 :active (>= (calc-stack-size) 1)]
129 ["Convert (1:) to a fraction" 151 ["Convert (1:) to a fraction"
130 (progn 152 (progn
131 (require 'calc-ext) 153 (require 'calc-ext)
132 (call-interactively 'calc-fraction)) 154 (call-interactively 'calc-fraction))
133 :keys "c F"]) 155 :keys "c F"
156 :active (>= (calc-stack-size) 1)])
134 (list "Binary" 157 (list "Binary"
135 ["Set word size" 158 ["Set word size"
136 (progn 159 (progn
@@ -142,60 +165,70 @@
142 (require 'calc-bin) 165 (require 'calc-bin)
143 (call-interactively 'calc-clip)) 166 (call-interactively 'calc-clip))
144 :keys "b c" 167 :keys "b c"
168 :active (>= (calc-stack-size) 1)
145 :help "Reduce (1:) modulo 2^wordsize"] 169 :help "Reduce (1:) modulo 2^wordsize"]
146 ["(2:) and (1:)" 170 ["(2:) and (1:)"
147 (progn 171 (progn
148 (require 'calc-bin) 172 (require 'calc-bin)
149 (call-interactively 'calc-and)) 173 (call-interactively 'calc-and))
150 :keys "b a" 174 :keys "b a"
175 :active (>= (calc-stack-size) 2)
151 :help "Bitwise AND [modulo 2^wordsize]"] 176 :help "Bitwise AND [modulo 2^wordsize]"]
152 ["(2:) or (1:)" 177 ["(2:) or (1:)"
153 (progn 178 (progn
154 (require 'calc-bin) 179 (require 'calc-bin)
155 (call-interactively 'calc-or)) 180 (call-interactively 'calc-or))
156 :keys "b o" 181 :keys "b o"
182 :active (>= (calc-stack-size) 2)
157 :help "Bitwise inclusive OR [modulo 2^wordsize]"] 183 :help "Bitwise inclusive OR [modulo 2^wordsize]"]
158 ["(2:) xor (1:)" 184 ["(2:) xor (1:)"
159 (progn 185 (progn
160 (require 'calc-bin) 186 (require 'calc-bin)
161 (call-interactively 'calc-xor)) 187 (call-interactively 'calc-xor))
162 :keys "b x" 188 :keys "b x"
189 :active (>= (calc-stack-size) 2)
163 :help "Bitwise exclusive OR [modulo 2^wordsize]"] 190 :help "Bitwise exclusive OR [modulo 2^wordsize]"]
164 ["diff(2:,1:)" 191 ["diff(2:,1:)"
165 (progn 192 (progn
166 (require 'calc-bin) 193 (require 'calc-bin)
167 (call-interactively 'calc-diff)) 194 (call-interactively 'calc-diff))
168 :keys "b d" 195 :keys "b d"
196 :active (>= (calc-stack-size) 2)
169 :help "Bitwise difference [modulo 2^wordsize]"] 197 :help "Bitwise difference [modulo 2^wordsize]"]
170 ["not (1:)" 198 ["not (1:)"
171 (progn 199 (progn
172 (require 'calc-bin) 200 (require 'calc-bin)
173 (call-interactively 'calc-not)) 201 (call-interactively 'calc-not))
174 :keys "b n" 202 :keys "b n"
203 :active (>= (calc-stack-size) 1)
175 :help "Bitwise NOT [modulo 2^wordsize]"] 204 :help "Bitwise NOT [modulo 2^wordsize]"]
176 ["left shift(1:)" 205 ["left shift(1:)"
177 (progn 206 (progn
178 (require 'calc-bin) 207 (require 'calc-bin)
179 (call-interactively 'calc-lshift-binary)) 208 (call-interactively 'calc-lshift-binary))
180 :keys "b l" 209 :keys "b l"
210 :active (>= (calc-stack-size) 1)
181 :help "Shift (1:)[modulo 2^wordsize] one bit left"] 211 :help "Shift (1:)[modulo 2^wordsize] one bit left"]
182 ["right shift(1:)" 212 ["right shift(1:)"
183 (progn 213 (progn
184 (require 'calc-bin) 214 (require 'calc-bin)
185 (call-interactively 'calc-rshift-binary)) 215 (call-interactively 'calc-rshift-binary))
186 :keys "b r" 216 :keys "b r"
217 :active (>= (calc-stack-size) 1)
187 :help "Shift (1:)[modulo 2^wordsize] one bit right, putting 0s on the left"] 218 :help "Shift (1:)[modulo 2^wordsize] one bit right, putting 0s on the left"]
188 ["arithmetic right shift(1:)" 219 ["arithmetic right shift(1:)"
189 (progn 220 (progn
190 (require 'calc-bin) 221 (require 'calc-bin)
191 (call-interactively 'calc-rshift-arith)) 222 (call-interactively 'calc-rshift-arith))
192 :keys "b R" 223 :keys "b R"
224 :active (>= (calc-stack-size) 1)
193 :help "Shift (1:)[modulo 2^wordsize] one bit right, duplicating the leftmost bit"] 225 :help "Shift (1:)[modulo 2^wordsize] one bit right, duplicating the leftmost bit"]
194 ["rotate(1:)" 226 ["rotate(1:)"
195 (progn 227 (progn
196 (require 'calc-bin) 228 (require 'calc-bin)
197 (call-interactively 'calc-rotate-binary)) 229 (call-interactively 'calc-rotate-binary))
198 :keys "b t" 230 :keys "b t"
231 :active (>= (calc-stack-size) 1)
199 :help "Rotate (1:)[modulo 2^wordsize] one bit left"]) 232 :help "Rotate (1:)[modulo 2^wordsize] one bit left"])
200 "-------" 233 "-------"
201 ["Help on Arithmetic" 234 ["Help on Arithmetic"
@@ -237,69 +270,82 @@
237 (require 'calc-math) 270 (require 'calc-math)
238 (call-interactively 'calc-ln)) 271 (call-interactively 'calc-ln))
239 :keys "L" 272 :keys "L"
273 :active (>= (calc-stack-size) 1)
240 :help "The natural logarithm"] 274 :help "The natural logarithm"]
241 ["e^(1:)" 275 ["e^(1:)"
242 (progn 276 (progn
243 (require 'calc-math) 277 (require 'calc-math)
244 (call-interactively 'calc-exp)) 278 (call-interactively 'calc-exp))
245 :keys "E"] 279 :keys "E"
280 :active (>= (calc-stack-size) 1)]
246 ["log(1:) [base 10]" 281 ["log(1:) [base 10]"
247 (progn 282 (progn
248 (require 'calc-math) 283 (require 'calc-math)
249 (call-interactively 'calc-log10)) 284 (call-interactively 'calc-log10))
250 :keys "H L" 285 :keys "H L"
286 :active (>= (calc-stack-size) 1)
251 :help "The common logarithm"] 287 :help "The common logarithm"]
252 ["10^(1:)" 288 ["10^(1:)"
253 (progn 289 (progn
254 (require 'calc-math) 290 (require 'calc-math)
255 (let ((calc-inverse-flag t)) 291 (let ((calc-inverse-flag t))
256 (call-interactively 'calc-log10))) 292 (call-interactively 'calc-log10)))
257 :keys "I H L"] 293 :keys "I H L"
294 :active (>= (calc-stack-size) 1)]
258 ["log(2:) [base(1:)]" 295 ["log(2:) [base(1:)]"
259 (progn 296 (progn
260 (require 'calc-math) 297 (require 'calc-math)
261 (call-interactively 'calc-log)) 298 (call-interactively 'calc-log))
262 :keys "B" 299 :keys "B"
300 :active (>= (calc-stack-size) 2)
263 :help "The logarithm with an arbitrary base"] 301 :help "The logarithm with an arbitrary base"]
264 ["(2:) ^ (1:)" 302 ["(2:) ^ (1:)"
265 calc-power 303 calc-power
266 :keys "^"]) 304 :keys "^"
305 :active (>= (calc-stack-size) 2)])
267 (list "Trigonometric Functions" 306 (list "Trigonometric Functions"
268 ["sin(1:)" 307 ["sin(1:)"
269 (progn 308 (progn
270 (require 'calc-math) 309 (require 'calc-math)
271 (call-interactively 'calc-sin)) 310 (call-interactively 'calc-sin))
272 :keys "S"] 311 :keys "S"
312 :active (>= (calc-stack-size) 1)]
273 ["cos(1:)" 313 ["cos(1:)"
274 (progn 314 (progn
275 (require 'calc-math) 315 (require 'calc-math)
276 (call-interactively 'calc-cos)) 316 (call-interactively 'calc-cos))
277 :keys "C"] 317 :keys "C"
318 :active (>= (calc-stack-size) 1)]
278 ["tan(1:)" 319 ["tan(1:)"
279 (progn 320 (progn
280 (require 'calc-math) 321 (require 'calc-math)
281 (call-interactively 'calc-tan)) 322 (call-interactively 'calc-tan))
282 :keys "T"] 323 :keys "T"
324 :active (>= (calc-stack-size) 1)]
283 ["arcsin(1:)" 325 ["arcsin(1:)"
284 (progn 326 (progn
285 (require 'calc-math) 327 (require 'calc-math)
286 (call-interactively 'calc-arcsin)) 328 (call-interactively 'calc-arcsin))
287 :keys "I S"] 329 :keys "I S"
330 :active (>= (calc-stack-size) 1)]
288 ["arccos(1:)" 331 ["arccos(1:)"
289 (progn 332 (progn
290 (require 'calc-math) 333 (require 'calc-math)
291 (call-interactively 'calc-arccos)) 334 (call-interactively 'calc-arccos))
292 :keys "I C"] 335 :keys "I C"
336 :active (>= (calc-stack-size) 1)]
293 ["arctan(1:)" 337 ["arctan(1:)"
294 (progn 338 (progn
295 (require 'calc-math) 339 (require 'calc-math)
296 (call-interactively 'calc-arctan)) 340 (call-interactively 'calc-arctan))
297 :keys "I T"] 341 :keys "I T"
342 :active (>= (calc-stack-size) 1)]
298 ["arctan2(2:,1:)" 343 ["arctan2(2:,1:)"
299 (progn 344 (progn
300 (require 'calc-math) 345 (require 'calc-math)
301 (call-interactively 'calc-arctan2)) 346 (call-interactively 'calc-arctan2))
302 :keys "f T"] 347 :keys "f T"
348 :active (>= (calc-stack-size) 2)]
303 "--Angle Measure--" 349 "--Angle Measure--"
304 ["Radians" 350 ["Radians"
305 (progn 351 (progn
@@ -327,133 +373,157 @@
327 (progn 373 (progn
328 (require 'calc-math) 374 (require 'calc-math)
329 (call-interactively 'calc-sinh)) 375 (call-interactively 'calc-sinh))
330 :keys "H S"] 376 :keys "H S"
377 :active (>= (calc-stack-size) 1)]
331 ["cosh(1:)" 378 ["cosh(1:)"
332 (progn 379 (progn
333 (require 'calc-math) 380 (require 'calc-math)
334 (call-interactively 'calc-cosh)) 381 (call-interactively 'calc-cosh))
335 :keys "H C"] 382 :keys "H C"
383 :active (>= (calc-stack-size) 1)]
336 ["tanh(1:)" 384 ["tanh(1:)"
337 (progn 385 (progn
338 (require 'calc-math) 386 (require 'calc-math)
339 (call-interactively 'calc-tanh)) 387 (call-interactively 'calc-tanh))
340 :keys "H T"] 388 :keys "H T"
389 :active (>= (calc-stack-size) 1)]
341 ["arcsinh(1:)" 390 ["arcsinh(1:)"
342 (progn 391 (progn
343 (require 'calc-math) 392 (require 'calc-math)
344 (call-interactively 'calc-arcsinh)) 393 (call-interactively 'calc-arcsinh))
345 :keys "I H S"] 394 :keys "I H S"
395 :active (>= (calc-stack-size) 1)]
346 ["arccosh(1:)" 396 ["arccosh(1:)"
347 (progn 397 (progn
348 (require 'calc-math) 398 (require 'calc-math)
349 (call-interactively 'calc-arccosh)) 399 (call-interactively 'calc-arccosh))
350 :keys "I H C"] 400 :keys "I H C"
401 :active (>= (calc-stack-size) 1)]
351 ["arctanh(1:)" 402 ["arctanh(1:)"
352 (progn 403 (progn
353 (require 'calc-math) 404 (require 'calc-math)
354 (call-interactively 'calc-arctanh)) 405 (call-interactively 'calc-arctanh))
355 :keys "I H T"]) 406 :keys "I H T"
407 :active (>= (calc-stack-size) 1)])
356 (list "Advanced Math Functions" 408 (list "Advanced Math Functions"
357 ["Gamma(1:)" 409 ["Gamma(1:)"
358 (progn 410 (progn
359 (require 'calc-comb) 411 (require 'calc-comb)
360 (call-interactively 'calc-gamma)) 412 (call-interactively 'calc-gamma))
361 :keys "f g" 413 :keys "f g"
414 :active (>= (calc-stack-size) 1)
362 :help "The Euler Gamma function"] 415 :help "The Euler Gamma function"]
363 ["GammaP(2:,1:)" 416 ["GammaP(2:,1:)"
364 (progn 417 (progn
365 (require 'calc-funcs) 418 (require 'calc-funcs)
366 (call-interactively 'calc-inc-gamma)) 419 (call-interactively 'calc-inc-gamma))
367 :keys "f G" 420 :keys "f G"
421 :active (>= (calc-stack-size) 2)
368 :help "The lower incomplete Gamma function"] 422 :help "The lower incomplete Gamma function"]
369 ["Beta(2:,1:)" 423 ["Beta(2:,1:)"
370 (progn 424 (progn
371 (require 'calc-funcs) 425 (require 'calc-funcs)
372 (call-interactively 'calc-beta)) 426 (call-interactively 'calc-beta))
373 :keys "f b" 427 :keys "f b"
428 :active (>= (calc-stack-size) 2)
374 :help "The Euler Beta function"] 429 :help "The Euler Beta function"]
375 ["BetaI(3:,2:,1:)" 430 ["BetaI(3:,2:,1:)"
376 (progn 431 (progn
377 (require 'calc-funcs) 432 (require 'calc-funcs)
378 (call-interactively 'calc-inc-beta)) 433 (call-interactively 'calc-inc-beta))
379 :keys "f B" 434 :keys "f B"
435 :active (>= (calc-stack-size) 3)
380 :help "The incomplete Beta function"] 436 :help "The incomplete Beta function"]
381 ["erf(1:)" 437 ["erf(1:)"
382 (progn 438 (progn
383 (require 'calc-funcs) 439 (require 'calc-funcs)
384 (call-interactively 'calc-erf)) 440 (call-interactively 'calc-erf))
385 :keys "f e" 441 :keys "f e"
442 :active (>= (calc-stack-size) 1)
386 :help "The error function"] 443 :help "The error function"]
387 ["BesselJ(2:,1:)" 444 ["BesselJ(2:,1:)"
388 (progn 445 (progn
389 (require 'calc-funcs) 446 (require 'calc-funcs)
390 (call-interactively 'calc-bessel-J)) 447 (call-interactively 'calc-bessel-J))
391 :keys "f j" 448 :keys "f j"
449 :active (>= (calc-stack-size) 2)
392 :help "The Bessel function of the first kind (of order (2:))"] 450 :help "The Bessel function of the first kind (of order (2:))"]
393 ["BesselY(2:,1:)" 451 ["BesselY(2:,1:)"
394 (progn 452 (progn
395 (require 'calc-funcs) 453 (require 'calc-funcs)
396 (call-interactively 'calc-bessel-Y)) 454 (call-interactively 'calc-bessel-Y))
397 :keys "f y" 455 :keys "f y"
456 :active (>= (calc-stack-size) 2)
398 :help "The Bessel function of the second kind (of order (2:))"]) 457 :help "The Bessel function of the second kind (of order (2:))"])
399 (list "Combinatorial Functions" 458 (list "Combinatorial Functions"
400 ["gcd(2:,1:)" 459 ["gcd(2:,1:)"
401 (progn 460 (progn
402 (require 'calc-comb) 461 (require 'calc-comb)
403 (call-interactively 'calc-gcd)) 462 (call-interactively 'calc-gcd))
404 :keys "k g"] 463 :keys "k g"
464 :active (>= (calc-stack-size) 2)]
405 ["lcm(2:,1:)" 465 ["lcm(2:,1:)"
406 (progn 466 (progn
407 (require 'calc-comb) 467 (require 'calc-comb)
408 (call-interactively 'calc-lcm)) 468 (call-interactively 'calc-lcm))
409 :keys "k l"] 469 :keys "k l"
470 :active (>= (calc-stack-size) 2)]
410 ["factorial(1:)" 471 ["factorial(1:)"
411 (progn 472 (progn
412 (require 'calc-comb) 473 (require 'calc-comb)
413 (call-interactively 'calc-factorial)) 474 (call-interactively 'calc-factorial))
414 :keys "!"] 475 :keys "!"
476 :active (>= (calc-stack-size) 1)]
415 ["(2:) choose (1:)" 477 ["(2:) choose (1:)"
416 (progn 478 (progn
417 (require 'calc-comb) 479 (require 'calc-comb)
418 (call-interactively 'calc-choose)) 480 (call-interactively 'calc-choose))
419 :keys "k c"] 481 :keys "k c"
482 :active (>= (calc-stack-size) 2)]
420 ["permutations(2:,1:)" 483 ["permutations(2:,1:)"
421 (progn 484 (progn
422 (require 'calc-comb) 485 (require 'calc-comb)
423 (call-interactively 'calc-perm)) 486 (call-interactively 'calc-perm))
424 :keys "H k c"] 487 :keys "H k c"
488 :active (>= (calc-stack-size) 2)]
425 ["Primality test for (1:)" 489 ["Primality test for (1:)"
426 (progn 490 (progn
427 (require 'calc-comb) 491 (require 'calc-comb)
428 (call-interactively 'calc-prime-test)) 492 (call-interactively 'calc-prime-test))
429 :keys "k p" 493 :keys "k p"
494 :active (>= (calc-stack-size) 1)
430 :help "For large (1:), a probabilistic test"] 495 :help "For large (1:), a probabilistic test"]
431 ["Factor (1:) into primes" 496 ["Factor (1:) into primes"
432 (progn 497 (progn
433 (require 'calc-comb) 498 (require 'calc-comb)
434 (call-interactively 'calc-prime-factors)) 499 (call-interactively 'calc-prime-factors))
435 :keys "k f"] 500 :keys "k f"
501 :active (>= (calc-stack-size) 1)]
436 ["Next prime after (1:)" 502 ["Next prime after (1:)"
437 (progn 503 (progn
438 (require 'calc-comb) 504 (require 'calc-comb)
439 (call-interactively 'calc-next-prime)) 505 (call-interactively 'calc-next-prime))
440 :keys "k n"] 506 :keys "k n"
507 :active (>= (calc-stack-size) 1)]
441 ["Previous prime before (1:)" 508 ["Previous prime before (1:)"
442 (progn 509 (progn
443 (require 'calc-comb) 510 (require 'calc-comb)
444 (call-interactively 'calc-prev-prime)) 511 (call-interactively 'calc-prev-prime))
445 :keys "I k n"] 512 :keys "I k n"
513 :active (>= (calc-stack-size) 1)]
446 ["phi(1:)" 514 ["phi(1:)"
447 (progn 515 (progn
448 (require 'calc-comb) 516 (require 'calc-comb)
449 (call-interactively 'calc-totient)) 517 (call-interactively 'calc-totient))
450 :keys "k n" 518 :keys "k n"
519 :active (>= (calc-stack-size) 1)
451 :help "Euler's totient function"] 520 :help "Euler's totient function"]
452 ["random(1:)" 521 ["random(1:)"
453 (progn 522 (progn
454 (require 'calc-comb) 523 (require 'calc-comb)
455 (call-interactively 'calc-random)) 524 (call-interactively 'calc-random))
456 :keys "k r" 525 :keys "k r"
526 :active (>= (calc-stack-size) 1)
457 :help "A random number >=1 and < (1:)"]) 527 :help "A random number >=1 and < (1:)"])
458 "----" 528 "----"
459 ["Help on Scientific Functions" 529 ["Help on Scientific Functions"
@@ -467,12 +537,14 @@
467 (progn 537 (progn
468 (require 'calc-alg) 538 (require 'calc-alg)
469 (call-interactively 'calc-simplify)) 539 (call-interactively 'calc-simplify))
470 :keys "a s"] 540 :keys "a s"
541 :active (>= (calc-stack-size) 1)]
471 ["Simplify (1:) with extended rules" 542 ["Simplify (1:) with extended rules"
472 (progn 543 (progn
473 (require 'calc-alg) 544 (require 'calc-alg)
474 (call-interactively 'calc-simplify-extended)) 545 (call-interactively 'calc-simplify-extended))
475 :keys "a e" 546 :keys "a e"
547 :active (>= (calc-stack-size) 1)
476 :help "Apply possibly unsafe simplifications"]) 548 :help "Apply possibly unsafe simplifications"])
477 (list "Manipulation" 549 (list "Manipulation"
478 ["Expand formula (1:)" 550 ["Expand formula (1:)"
@@ -480,17 +552,20 @@
480 (require 'calc-alg) 552 (require 'calc-alg)
481 (call-interactively 'calc-expand-formula)) 553 (call-interactively 'calc-expand-formula))
482 :keys "a \"" 554 :keys "a \""
555 :active (>= (calc-stack-size) 1)
483 :help "Expand (1:) into its defining formula, if possible"] 556 :help "Expand (1:) into its defining formula, if possible"]
484 ["Evaluate variables in (1:)" 557 ["Evaluate variables in (1:)"
485 (progn 558 (progn
486 (require 'calc-ext) 559 (require 'calc-ext)
487 (call-interactively 'calc-evaluate)) 560 (call-interactively 'calc-evaluate))
488 :keys "="] 561 :keys "="
562 :active (>= (calc-stack-size) 1)]
489 ["Make substitution in (1:)" 563 ["Make substitution in (1:)"
490 (progn 564 (progn
491 (require 'calc-alg) 565 (require 'calc-alg)
492 (call-interactively 'calc-substitute)) 566 (call-interactively 'calc-substitute))
493 :keys "a b" 567 :keys "a b"
568 :active (>= (calc-stack-size) 1)
494 :help 569 :help
495 "Substitute all occurrences of a sub-expression with a new sub-expression"]) 570 "Substitute all occurrences of a sub-expression with a new sub-expression"])
496 (list "Polynomials" 571 (list "Polynomials"
@@ -498,87 +573,102 @@
498 (progn 573 (progn
499 (require 'calc-alg) 574 (require 'calc-alg)
500 (call-interactively 'calc-factor)) 575 (call-interactively 'calc-factor))
501 :keys "a f"] 576 :keys "a f"
577 :active (>= (calc-stack-size) 1)]
502 ["Collect terms in (1:)" 578 ["Collect terms in (1:)"
503 (progn 579 (progn
504 (require 'calc-alg) 580 (require 'calc-alg)
505 (call-interactively 'calc-collect)) 581 (call-interactively 'calc-collect))
506 :keys "a c" 582 :keys "a c"
583 :active (>= (calc-stack-size) 1)
507 :help "Arrange as a polynomial in a given variable"] 584 :help "Arrange as a polynomial in a given variable"]
508 ["Expand (1:)" 585 ["Expand (1:)"
509 (progn 586 (progn
510 (require 'calc-alg) 587 (require 'calc-alg)
511 (call-interactively 'calc-expand)) 588 (call-interactively 'calc-expand))
512 :keys "a x" 589 :keys "a x"
590 :active (>= (calc-stack-size) 1)
513 :help "Apply distributive law everywhere"] 591 :help "Apply distributive law everywhere"]
514 ["Find roots of (1:)" 592 ["Find roots of (1:)"
515 (progn 593 (progn
516 (require 'calcalg2) 594 (require 'calcalg2)
517 (call-interactively 'calc-poly-roots)) 595 (call-interactively 'calc-poly-roots))
518 :keys "a P"]) 596 :keys "a P"
597 :active (>= (calc-stack-size) 1)])
519 (list "Calculus" 598 (list "Calculus"
520 ["Differentiate (1:)" 599 ["Differentiate (1:)"
521 (progn 600 (progn
522 (require 'calcalg2) 601 (require 'calcalg2)
523 (call-interactively 'calc-derivative)) 602 (call-interactively 'calc-derivative))
524 :keys "a d"] 603 :keys "a d"
604 :active (>= (calc-stack-size) 1)]
525 ["Integrate (1:) [indefinite]" 605 ["Integrate (1:) [indefinite]"
526 (progn 606 (progn
527 (require 'calcalg2) 607 (require 'calcalg2)
528 (call-interactively 'calc-integral)) 608 (call-interactively 'calc-integral))
529 :keys "a i"] 609 :keys "a i"
610 :active (>= (calc-stack-size) 1)]
530 ["Integrate (1:) [definite]" 611 ["Integrate (1:) [definite]"
531 (progn 612 (progn
532 (require 'calcalg2) 613 (require 'calcalg2)
533 (let ((var (read-string "Integration variable: "))) 614 (let ((var (read-string "Integration variable: ")))
534 (calc-tabular-command 'calcFunc-integ "Integration" 615 (calc-tabular-command 'calcFunc-integ "Integration"
535 "intg" nil var nil nil))) 616 "intg" nil var nil nil)))
536 :keys "C-u a i"] 617 :keys "C-u a i"
618 :active (>= (calc-stack-size) 1)]
537 ["Integrate (1:) [numeric]" 619 ["Integrate (1:) [numeric]"
538 (progn 620 (progn
539 (require 'calcalg2) 621 (require 'calcalg2)
540 (call-interactively 'calc-num-integral)) 622 (call-interactively 'calc-num-integral))
541 :keys "a I" 623 :keys "a I"
624 :active (>= (calc-stack-size) 1)
542 :help "Integrate using the open Romberg method"] 625 :help "Integrate using the open Romberg method"]
543 ["Taylor expand (1:)" 626 ["Taylor expand (1:)"
544 (progn 627 (progn
545 (require 'calcalg2) 628 (require 'calcalg2)
546 (call-interactively 'calc-taylor)) 629 (call-interactively 'calc-taylor))
547 :keys "a t"] 630 :keys "a t"
631 :active (>= (calc-stack-size) 1)]
548 ["Minimize (2:) [initial guess = (1:)]" 632 ["Minimize (2:) [initial guess = (1:)]"
549 (progn 633 (progn
550 (require 'calcalg3) 634 (require 'calcalg3)
551 (call-interactively 'calc-find-minimum)) 635 (call-interactively 'calc-find-minimum))
552 :keys "a N" 636 :keys "a N"
637 :active (>= (calc-stack-size) 2)
553 :help "Find a local minimum"] 638 :help "Find a local minimum"]
554 ["Maximize (2:) [initial guess = (1:)]" 639 ["Maximize (2:) [initial guess = (1:)]"
555 (progn 640 (progn
556 (require 'calcalg3) 641 (require 'calcalg3)
557 (call-interactively 'calc-find-maximum)) 642 (call-interactively 'calc-find-maximum))
558 :keys "a X" 643 :keys "a X"
644 :active (>= (calc-stack-size) 2)
559 :help "Find a local maximum"]) 645 :help "Find a local maximum"])
560 (list "Solving" 646 (list "Solving"
561 ["Solve equation (1:)" 647 ["Solve equation (1:)"
562 (progn 648 (progn
563 (require 'calcalg2) 649 (require 'calcalg2)
564 (call-interactively 'calc-solve-for)) 650 (call-interactively 'calc-solve-for))
565 :keys "a S"] 651 :keys "a S"
652 :active (>= (calc-stack-size) 1)]
566 ["Solve equation (2:) numerically [initial guess = (1:)]" 653 ["Solve equation (2:) numerically [initial guess = (1:)]"
567 (progn 654 (progn
568 (require 'calcalg3) 655 (require 'calcalg3)
569 (call-interactively 'calc-find-root)) 656 (call-interactively 'calc-find-root))
570 :keys "a R"] 657 :keys "a R"
658 :active (>= (calc-stack-size) 2)]
571 ["Find roots of polynomial (1:)" 659 ["Find roots of polynomial (1:)"
572 (progn 660 (progn
573 (require 'calcalg2) 661 (require 'calcalg2)
574 (call-interactively 'calc-poly-roots)) 662 (call-interactively 'calc-poly-roots))
575 :keys "a P"]) 663 :keys "a P"
664 :active (>= (calc-stack-size) 1)])
576 (list "Curve Fitting" 665 (list "Curve Fitting"
577 ["Fit (1:)=[x values, y values] to a curve" 666 ["Fit (1:)=[x values, y values] to a curve"
578 (progn 667 (progn
579 (require 'calcalg3) 668 (require 'calcalg3)
580 (call-interactively 'calc-curve-fit)) 669 (call-interactively 'calc-curve-fit))
581 :keys "a F"]) 670 :keys "a F"
671 :active (>= (calc-stack-size) 1)])
582 "----" 672 "----"
583 ["Help on Algebra" 673 ["Help on Algebra"
584 (calc-info-goto-node "Algebra")]) 674 (calc-info-goto-node "Algebra")])
@@ -591,12 +681,14 @@
591 (progn 681 (progn
592 (require 'calc-graph) 682 (require 'calc-graph)
593 (call-interactively 'calc-graph-fast)) 683 (call-interactively 'calc-graph-fast))
594 :keys "g f"] 684 :keys "g f"
685 :active (>= (calc-stack-size) 2)]
595 ["Graph 3D [(1:)= z values, (2:)= y values, (3:)= x values]" 686 ["Graph 3D [(1:)= z values, (2:)= y values, (3:)= x values]"
596 (progn 687 (progn
597 (require 'calc-graph) 688 (require 'calc-graph)
598 (call-interactively 'calc-graph-fast-3d)) 689 (call-interactively 'calc-graph-fast-3d))
599 :keys "g F"] 690 :keys "g F"
691 :active (>= (calc-stack-size) 3)]
600 "----" 692 "----"
601 ["Help on Graphics" 693 ["Help on Graphics"
602 (calc-info-goto-node "Graphics")]) 694 (calc-info-goto-node "Graphics")])
@@ -606,14 +698,18 @@
606(defvar calc-vectors-menu 698(defvar calc-vectors-menu
607 (list "Matrices/Vectors" 699 (list "Matrices/Vectors"
608 (list "Matrices" 700 (list "Matrices"
609 ["(2:) + (1:)" calc-plus :keys "+"] 701 ["(2:) + (1:)" calc-plus
610 ["(2:) - (1:)" calc-minus :keys "-"] 702 :keys "+" :active (>= (calc-stack-size) 2)]
611 ["(2:) * (1:)" calc-times :keys "*"] 703 ["(2:) - (1:)" calc-minus
612 ["(1:)^(-1)" 704 :keys "-" :active (>= (calc-stack-size) 2)]
705 ["(2:) * (1:)" calc-times
706 :keys "*" :active (>= (calc-stack-size) 2)]
707 ["(1:)^(-1)"
613 (progn 708 (progn
614 (require 'calc-arith) 709 (require 'calc-arith)
615 (call-interactively 'calc-inv)) 710 (call-interactively 'calc-inv))
616 :keys "&"] 711 :keys "&"
712 :active (>= (calc-stack-size) 1)]
617 ["Create an identity matrix" 713 ["Create an identity matrix"
618 (progn 714 (progn
619 (require 'calc-vec) 715 (require 'calc-vec)
@@ -623,179 +719,211 @@
623 (progn 719 (progn
624 (require 'calc-vec) 720 (require 'calc-vec)
625 (call-interactively 'calc-transpose)) 721 (call-interactively 'calc-transpose))
626 :keys "v t"] 722 :keys "v t"
723 :active (>= (calc-stack-size) 1)]
627 ["det(1:)" 724 ["det(1:)"
628 (progn 725 (progn
629 (require 'calc-mtx) 726 (require 'calc-mtx)
630 (call-interactively 'calc-mdet)) 727 (call-interactively 'calc-mdet))
631 :keys "V D"] 728 :keys "V D"
729 :active (>= (calc-stack-size) 1)]
632 ["trace(1:)" 730 ["trace(1:)"
633 (progn 731 (progn
634 (require 'calc-mtx) 732 (require 'calc-mtx)
635 (call-interactively 'calc-mtrace)) 733 (call-interactively 'calc-mtrace))
636 :keys "V T"] 734 :keys "V T"
735 :active (>= (calc-stack-size) 1)]
637 ["LUD decompose (1:)" 736 ["LUD decompose (1:)"
638 (progn 737 (progn
639 (require 'calc-mtx) 738 (require 'calc-mtx)
640 (call-interactively 'calc-mlud)) 739 (call-interactively 'calc-mlud))
641 :keys "V L"] 740 :keys "V L"
741 :active (>= (calc-stack-size) 1)]
642 ["Extract a row from (1:)" 742 ["Extract a row from (1:)"
643 (progn 743 (progn
644 (require 'calc-vec) 744 (require 'calc-vec)
645 (call-interactively 'calc-mrow)) 745 (call-interactively 'calc-mrow))
646 :keys "v r"] 746 :keys "v r"
747 :active (>= (calc-stack-size) 1)]
647 ["Extract a column from (1:)" 748 ["Extract a column from (1:)"
648 (progn 749 (progn
649 (require 'calc-vec) 750 (require 'calc-vec)
650 (call-interactively 'calc-mcol)) 751 (call-interactively 'calc-mcol))
651 :keys "v c"]) 752 :keys "v c"
753 :active (>= (calc-stack-size) 1)])
652 (list "Vectors" 754 (list "Vectors"
653 ["Extract the first element of (1:)" 755 ["Extract the first element of (1:)"
654 (progn 756 (progn
655 (require 'calc-vec) 757 (require 'calc-vec)
656 (call-interactively 'calc-head)) 758 (call-interactively 'calc-head))
657 :keys "v h"] 759 :keys "v h"
760 :active (>= (calc-stack-size) 1)]
658 ["Extract an element from (1:)" 761 ["Extract an element from (1:)"
659 (progn 762 (progn
660 (require 'calc-vec) 763 (require 'calc-vec)
661 (call-interactively 'calc-mrow)) 764 (call-interactively 'calc-mrow))
662 :keys "v r"] 765 :keys "v r"
766 :active (>= (calc-stack-size) 1)]
663 ["Reverse (1:)" 767 ["Reverse (1:)"
664 (progn 768 (progn
665 (require 'calc-vec) 769 (require 'calc-vec)
666 (call-interactively 'calc-reverse-vector)) 770 (call-interactively 'calc-reverse-vector))
667 :keys "v v"] 771 :keys "v v"
772 :active (>= (calc-stack-size) 1)]
668 ["Unpack (1:)" 773 ["Unpack (1:)"
669 (progn 774 (progn
670 (require 'calc-vec) 775 (require 'calc-vec)
671 (call-interactively 'calc-unpack)) 776 (call-interactively 'calc-unpack))
672 :keys "v u" 777 :keys "v u"
778 :active (>= (calc-stack-size) 1)
673 :help "Separate the elements of (1:)"] 779 :help "Separate the elements of (1:)"]
674 ["(2:) cross (1:)" 780 ["(2:) cross (1:)"
675 (progn 781 (progn
676 (require 'calc-vec) 782 (require 'calc-vec)
677 (call-interactively 'calc-cross)) 783 (call-interactively 'calc-cross))
678 :keys "V C" 784 :keys "V C"
785 :active (>= (calc-stack-size) 2)
679 :help "The cross product in R^3"] 786 :help "The cross product in R^3"]
680 ["(2:) dot (1:)" 787 ["(2:) dot (1:)"
681 calc-mult 788 calc-mult
682 :keys "*" 789 :keys "*"
790 :active (>= (calc-stack-size) 2)
683 :help "The dot product"] 791 :help "The dot product"]
684 ["Map a function across (1:)" 792 ["Map a function across (1:)"
685 (progn 793 (progn
686 (require 'calc-map) 794 (require 'calc-map)
687 (call-interactively 'calc-map)) 795 (call-interactively 'calc-map))
688 :keys "V M" 796 :keys "V M"
797 :active (>= (calc-stack-size) 1)
689 :help "Apply a function to each element"]) 798 :help "Apply a function to each element"])
690 (list "Vectors As Sets" 799 (list "Vectors As Sets"
691 ["Remove duplicates from (1:)" 800 ["Remove duplicates from (1:)"
692 (progn 801 (progn
693 (require 'calc-vec) 802 (require 'calc-vec)
694 (call-interactively 'calc-remove-duplicates)) 803 (call-interactively 'calc-remove-duplicates))
695 :keys "V +"] 804 :keys "V +"
805 :active (>= (calc-stack-size) 1)]
696 ["(2:) union (1:)" 806 ["(2:) union (1:)"
697 (progn 807 (progn
698 (require 'calc-vec) 808 (require 'calc-vec)
699 (call-interactively 'calc-set-union)) 809 (call-interactively 'calc-set-union))
700 :keys "V V"] 810 :keys "V V"
811 :active (>= (calc-stack-size) 2)]
701 ["(2:) intersect (1:)" 812 ["(2:) intersect (1:)"
702 (progn 813 (progn
703 (require 'calc-vec) 814 (require 'calc-vec)
704 (call-interactively 'calc-set-intersect)) 815 (call-interactively 'calc-set-intersect))
705 :keys "V ^"] 816 :keys "V ^"
817 :active (>= (calc-stack-size) 2)]
706 ["(2:) \\ (1:)" 818 ["(2:) \\ (1:)"
707 (progn 819 (progn
708 (require 'calc-vec) 820 (require 'calc-vec)
709 (call-interactively 'calc-set-difference)) 821 (call-interactively 'calc-set-difference))
710 :keys "V -" 822 :keys "V -"
711 :help "Set difference"]) 823 :help "Set difference"
824 :active (>= (calc-stack-size) 2)])
712 (list "Statistics On Vectors" 825 (list "Statistics On Vectors"
713 ["length(1:)" 826 ["length(1:)"
714 (progn 827 (progn
715 (require 'calc-stat) 828 (require 'calc-stat)
716 (call-interactively 'calc-vector-count)) 829 (call-interactively 'calc-vector-count))
717 :keys "u #" 830 :keys "u #"
831 :active (>= (calc-stack-size) 1)
718 :help "The number of data values"] 832 :help "The number of data values"]
719 ["sum(1:)" 833 ["sum(1:)"
720 (progn 834 (progn
721 (require 'calc-stat) 835 (require 'calc-stat)
722 (call-interactively 'calc-vector-sum)) 836 (call-interactively 'calc-vector-sum))
723 :keys "u +" 837 :keys "u +"
838 :active (>= (calc-stack-size) 1)
724 :help "The sum of the data values"] 839 :help "The sum of the data values"]
725 ["max(1:)" 840 ["max(1:)"
726 (progn 841 (progn
727 (require 'calc-stat) 842 (require 'calc-stat)
728 (call-interactively 'calc-vector-max)) 843 (call-interactively 'calc-vector-max))
729 :keys "u x" 844 :keys "u x"
845 :active (>= (calc-stack-size) 1)
730 :help "The maximum of the data values"] 846 :help "The maximum of the data values"]
731 ["min(1:)" 847 ["min(1:)"
732 (progn 848 (progn
733 (require 'calc-stat) 849 (require 'calc-stat)
734 (call-interactively 'calc-vector-min)) 850 (call-interactively 'calc-vector-min))
735 :keys "u N" 851 :keys "u N"
852 :active (>= (calc-stack-size) 1)
736 :help "The minumum of the data values"] 853 :help "The minumum of the data values"]
737 ["mean(1:)" 854 ["mean(1:)"
738 (progn 855 (progn
739 (require 'calc-stat) 856 (require 'calc-stat)
740 (call-interactively 'calc-vector-mean)) 857 (call-interactively 'calc-vector-mean))
741 :keys "u M" 858 :keys "u M"
859 :active (>= (calc-stack-size) 1)
742 :help "The average (arithmetic mean) of the data values"] 860 :help "The average (arithmetic mean) of the data values"]
743 ["mean(1:) with error" 861 ["mean(1:) with error"
744 (progn 862 (progn
745 (require 'calc-stat) 863 (require 'calc-stat)
746 (call-interactively 'calc-vector-mean-error)) 864 (call-interactively 'calc-vector-mean-error))
747 :keys "I u M" 865 :keys "I u M"
866 :active (>= (calc-stack-size) 1)
748 :help "The average (arithmetic mean) of the data values as an error form"] 867 :help "The average (arithmetic mean) of the data values as an error form"]
749 ["sdev(1:)" 868 ["sdev(1:)"
750 (progn 869 (progn
751 (require 'calc-stat) 870 (require 'calc-stat)
752 (call-interactively 'calc-vector-sdev)) 871 (call-interactively 'calc-vector-sdev))
753 :keys "u S" 872 :keys "u S"
873 :active (>= (calc-stack-size) 1)
754 :help "The sample sdev, sqrt[sum((values - mean)^2)/(N-1)]"] 874 :help "The sample sdev, sqrt[sum((values - mean)^2)/(N-1)]"]
755 ["variance(1:)" 875 ["variance(1:)"
756 (progn 876 (progn
757 (require 'calc-stat) 877 (require 'calc-stat)
758 (call-interactively 'calc-vector-variance)) 878 (call-interactively 'calc-vector-variance))
759 :keys "H u S" 879 :keys "H u S"
880 :active (>= (calc-stack-size) 1)
760 :help "The sample variance, sum((values - mean)^2)/(N-1)"] 881 :help "The sample variance, sum((values - mean)^2)/(N-1)"]
761 ["population sdev(1:)" 882 ["population sdev(1:)"
762 (progn 883 (progn
763 (require 'calc-stat) 884 (require 'calc-stat)
764 (call-interactively 'calc-vector-pop-sdev)) 885 (call-interactively 'calc-vector-pop-sdev))
765 :keys "I u S" 886 :keys "I u S"
887 :active (>= (calc-stack-size) 1)
766 :help "The population sdev, sqrt[sum((values - mean)^2)/N]"] 888 :help "The population sdev, sqrt[sum((values - mean)^2)/N]"]
767 ["population variance(1:)" 889 ["population variance(1:)"
768 (progn 890 (progn
769 (require 'calc-stat) 891 (require 'calc-stat)
770 (call-interactively 'calc-vector-pop-variance)) 892 (call-interactively 'calc-vector-pop-variance))
771 :keys "H I u S" 893 :keys "H I u S"
894 :active (>= (calc-stack-size) 1)
772 :help "The population variance, sum((values - mean)^2)/N"] 895 :help "The population variance, sum((values - mean)^2)/N"]
773 ["median(1:)" 896 ["median(1:)"
774 (progn 897 (progn
775 (require 'calc-stat) 898 (require 'calc-stat)
776 (call-interactively 'calc-vector-median)) 899 (call-interactively 'calc-vector-median))
777 :keys "H u M" 900 :keys "H u M"
901 :active (>= (calc-stack-size) 1)
778 :help "The median of the data values"] 902 :help "The median of the data values"]
779 ["harmonic mean(1:)" 903 ["harmonic mean(1:)"
780 (progn 904 (progn
781 (require 'calc-stat) 905 (require 'calc-stat)
782 (call-interactively 'calc-vector-harmonic-mean)) 906 (call-interactively 'calc-vector-harmonic-mean))
783 :keys "H I u M"] 907 :keys "H I u M"
908 :active (>= (calc-stack-size) 1)]
784 ["geometric mean(1:)" 909 ["geometric mean(1:)"
785 (progn 910 (progn
786 (require 'calc-stat) 911 (require 'calc-stat)
787 (call-interactively 'calc-vector-geometric-mean)) 912 (call-interactively 'calc-vector-geometric-mean))
788 :keys "u G"] 913 :keys "u G"
914 :active (>= (calc-stack-size) 1)]
789 ["arithmetic-geometric mean(1:)" 915 ["arithmetic-geometric mean(1:)"
790 (progn 916 (progn
791 (require 'calc-stat) 917 (require 'calc-stat)
792 (let ((calc-hyperbolic-flag t)) 918 (let ((calc-hyperbolic-flag t))
793 (call-interactively 'calc-vector-geometric-mean))) 919 (call-interactively 'calc-vector-geometric-mean)))
794 :keys "H u G"] 920 :keys "H u G"
921 :active (>= (calc-stack-size) 1)]
795 ["RMS(1:)" 922 ["RMS(1:)"
796 (progn (require 'calc-arith) 923 (progn (require 'calc-arith)
797 (call-interactively 'calc-abs)) 924 (call-interactively 'calc-abs))
798 :keys "A" 925 :keys "A"
926 :active (>= (calc-stack-size) 1)
799 :help "The root-mean-square, or quadratic mean"]) 927 :help "The root-mean-square, or quadratic mean"])
800 ["Abbreviate long vectors" 928 ["Abbreviate long vectors"
801 (progn 929 (progn
@@ -815,17 +943,20 @@
815 (progn 943 (progn
816 (require 'calc-units) 944 (require 'calc-units)
817 (call-interactively 'calc-convert-units )) 945 (call-interactively 'calc-convert-units ))
818 :keys "u c"] 946 :keys "u c"
947 :active (>= (calc-stack-size) 1)]
819 ["Convert temperature in (1:)" 948 ["Convert temperature in (1:)"
820 (progn 949 (progn
821 (require 'calc-units) 950 (require 'calc-units)
822 (call-interactively 'calc-convert-temperature)) 951 (call-interactively 'calc-convert-temperature))
823 :keys "u t"] 952 :keys "u t"
953 :active (>= (calc-stack-size) 1)]
824 ["Simplify units in (1:)" 954 ["Simplify units in (1:)"
825 (progn 955 (progn
826 (require 'calc-units) 956 (require 'calc-units)
827 (call-interactively 'calc-simplify-units)) 957 (call-interactively 'calc-simplify-units))
828 :keys "u s"] 958 :keys "u s"
959 :active (>= (calc-stack-size) 1)]
829 ["View units table" 960 ["View units table"
830 (progn 961 (progn
831 (require 'calc-units) 962 (require 'calc-units)
@@ -842,7 +973,8 @@
842 (progn 973 (progn
843 (require 'calc-store) 974 (require 'calc-store)
844 (call-interactively 'calc-store)) 975 (call-interactively 'calc-store))
845 :keys "s s"] 976 :keys "s s"
977 :active (>= (calc-stack-size) 1)]
846 ["Recall a variable value" 978 ["Recall a variable value"
847 (progn 979 (progn
848 (require 'calc-store) 980 (require 'calc-store)
@@ -857,7 +989,8 @@
857 (progn 989 (progn
858 (require 'calc-store) 990 (require 'calc-store)
859 (call-interactively 'calc-store-exchange)) 991 (call-interactively 'calc-store-exchange))
860 :keys "s x"] 992 :keys "s x"
993 :active (>= (calc-stack-size) 1)]
861 ["Clear variable value" 994 ["Clear variable value"
862 (progn 995 (progn
863 (require 'calc-store) 996 (require 'calc-store)
@@ -867,12 +1000,14 @@
867 (progn 1000 (progn
868 (require 'calc-ext) 1001 (require 'calc-ext)
869 (call-interactively 'calc-evaluate)) 1002 (call-interactively 'calc-evaluate))
870 :keys "="] 1003 :keys "="
1004 :active (>= (calc-stack-size) 1)]
871 ["Evaluate (1:), assigning a value to a variable" 1005 ["Evaluate (1:), assigning a value to a variable"
872 (progn 1006 (progn
873 (require 'calc-store) 1007 (require 'calc-store)
874 (call-interactively 'calc-let)) 1008 (call-interactively 'calc-let))
875 :keys "s l" 1009 :keys "s l"
1010 :active (>= (calc-stack-size) 1)
876 :help "Evaluate (1:) under a temporary assignment of a variable"] 1011 :help "Evaluate (1:) under a temporary assignment of a variable"]
877 "----" 1012 "----"
878 ["Help on Variables" 1013 ["Help on Variables"
@@ -883,18 +1018,22 @@
883 (list "Stack" 1018 (list "Stack"
884 ["Remove (1:)" 1019 ["Remove (1:)"
885 calc-pop 1020 calc-pop
886 :keys "DEL"] 1021 :keys "DEL"
1022 :active (>= (calc-stack-size) 1)]
887 ["Switch (1:) and (2:)" 1023 ["Switch (1:) and (2:)"
888 calc-roll-down 1024 calc-roll-down
889 :keys "TAB"] 1025 :keys "TAB"
1026 :active (>= (calc-stack-size) 2)]
890 ["Duplicate (1:)" 1027 ["Duplicate (1:)"
891 calc-enter 1028 calc-enter
892 :keys "RET"] 1029 :keys "RET"
1030 :active (>= (calc-stack-size) 1)]
893 ["Edit (1:)" 1031 ["Edit (1:)"
894 (progn 1032 (progn
895 (require 'calc-yank) 1033 (require 'calc-yank)
896 (call-interactively calc-edit)) 1034 (call-interactively calc-edit))
897 :keys "`"] 1035 :keys "`"
1036 :active (>= (calc-stack-size) 1)]
898 "----" 1037 "----"
899 ["Help on Stack" 1038 ["Help on Stack"
900 (calc-info-goto-node "Stack and Trail")]) 1039 (calc-info-goto-node "Stack and Trail")])
@@ -1051,6 +1190,47 @@
1051 :keys "d e" 1190 :keys "d e"
1052 :style radio 1191 :style radio
1053 :selected (eq (car-safe calc-float-format) 'eng)]) 1192 :selected (eq (car-safe calc-float-format) 'eng)])
1193 (list "Complex Format"
1194 ["Default"
1195 (progn
1196 (require 'calc-cplx)
1197 (calc-complex-notation))
1198 :style radio
1199 :selected (not calc-complex-format)
1200 :keys "d c"
1201 :help "Display complex numbers as ordered pairs."]
1202 ["i notation"
1203 (progn
1204 (require 'calc-cplx)
1205 (calc-i-notation))
1206 :style radio
1207 :selected (eq calc-complex-format 'i)
1208 :keys "d i"
1209 :help "Display complex numbers as a+bi."]
1210 ["j notation"
1211 (progn
1212 (require 'calc-cplx)
1213 (calc-i-notation))
1214 :style radio
1215 :selected (eq calc-complex-format 'j)
1216 :keys "d j"
1217 :help "Display complex numbers as a+bj."]
1218 ["Other"
1219 (calc-complex-notation)
1220 :style radio
1221 :selected (and calc-complex-format
1222 (not (eq calc-complex-format 'i))
1223 (not (eq calc-complex-format 'j)))
1224 :active nil]
1225 "----"
1226 ["Polar mode"
1227 (progn
1228 (require 'calc-cplx)
1229 (calc-polar-mode nil))
1230 :style toggle
1231 :selected (eq calc-complex-mode 'polar)
1232 :keys "m p"
1233 :help "Prefer polar form for complex numbers."])
1054 (list "Algebraic" 1234 (list "Algebraic"
1055 ["Normal" 1235 ["Normal"
1056 (progn 1236 (progn
@@ -1178,7 +1358,21 @@
1178 (call-interactively 'calc-giac-language)) 1358 (call-interactively 'calc-giac-language))
1179 :keys "d A" 1359 :keys "d A"
1180 :style radio 1360 :style radio
1181 :selected (eq calc-language 'giac)]) 1361 :selected (eq calc-language 'giac)]
1362 ["Mma"
1363 (progn
1364 (require 'calc-lang)
1365 (call-interactively 'calc-mathematica-language))
1366 :keys "d M"
1367 :style radio
1368 :selected (eq calc-language 'math)]
1369 ["Maple"
1370 (progn
1371 (require 'calc-lang)
1372 (call-interactively 'calc-maple-language))
1373 :keys "d W"
1374 :style radio
1375 :selected (eq calc-language 'maple)])
1182 "----" 1376 "----"
1183 ["Save mode settings" calc-save-modes :keys "m m"] 1377 ["Save mode settings" calc-save-modes :keys "m m"]
1184 "----" 1378 "----"
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index a7c4b20e30d..ac1c0cd0080 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -491,9 +491,14 @@ If EXPR is nil, return nil."
491 (when (eq (car-safe unew) 'error) 491 (when (eq (car-safe unew) 'error)
492 (error "Bad format in units expression: %s" (nth 2 unew))) 492 (error "Bad format in units expression: %s" (nth 2 unew)))
493 (math-put-default-units unew) 493 (math-put-default-units unew)
494 (calc-enter-result 1 "cvtm" (math-simplify-units 494 (let ((ntemp (calc-normalize
495 (math-convert-temperature expr uold unew 495 (math-simplify-units
496 uoldname)))))) 496 (math-convert-temperature expr uold unew
497 uoldname)))))
498 (if (Math-zerop ntemp)
499 (setq ntemp (list '* ntemp unew)))
500 (let ((calc-simplify-mode 'none))
501 (calc-enter-result 1 "cvtm" ntemp))))))
497 502
498(defun calc-remove-units () 503(defun calc-remove-units ()
499 (interactive) 504 (interactive)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index b9e462ec05f..b46981f137b 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1395,7 +1395,7 @@ that are not customizable options, as well as faces and groups
1395(defun customize-apropos-options (regexp &optional arg) 1395(defun customize-apropos-options (regexp &optional arg)
1396 "Customize all loaded customizable options matching REGEXP. 1396 "Customize all loaded customizable options matching REGEXP.
1397With prefix arg, include variables that are not customizable options 1397With prefix arg, include variables that are not customizable options
1398\(but we recommend using `apropos-variable' instead)." 1398\(but it is better to use `apropos-variable' if you want to find those)."
1399 (interactive "sCustomize options (regexp): \nP") 1399 (interactive "sCustomize options (regexp): \nP")
1400 (customize-apropos regexp (or arg 'options))) 1400 (customize-apropos regexp (or arg 'options)))
1401 1401
@@ -2258,7 +2258,8 @@ Insert PREFIX first if non-nil."
2258 (insert ", ")))) 2258 (insert ", "))))
2259 (widget-put widget :buttons buttons)))) 2259 (widget-put widget :buttons buttons))))
2260 2260
2261(defun custom-add-parent-links (widget &optional initial-string) 2261(defun custom-add-parent-links (widget &optional initial-string
2262 doc-initial-string)
2262 "Add \"Parent groups: ...\" to WIDGET if the group has parents. 2263 "Add \"Parent groups: ...\" to WIDGET if the group has parents.
2263The value is non-nil if any parents were found. 2264The value is non-nil if any parents were found.
2264If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." 2265If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
@@ -2267,7 +2268,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2267 (buttons (widget-get widget :buttons)) 2268 (buttons (widget-get widget :buttons))
2268 (start (point)) 2269 (start (point))
2269 (parents nil)) 2270 (parents nil))
2270 (insert (or initial-string "Parent groups:")) 2271 (insert (or initial-string "Groups:"))
2271 (mapatoms (lambda (symbol) 2272 (mapatoms (lambda (symbol)
2272 (when (member (list name type) (get symbol 'custom-group)) 2273 (when (member (list name type) (get symbol 'custom-group))
2273 (insert " ") 2274 (insert " ")
@@ -2286,23 +2287,27 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2286 (get (car parents) 'custom-links)))) 2287 (get (car parents) 'custom-links))))
2287 (many (> (length links) 2))) 2288 (many (> (length links) 2)))
2288 (when links 2289 (when links
2289 (insert "\nParent documentation: ") 2290 (let ((pt (point))
2290 (while links 2291 (left-margin (+ left-margin 2)))
2291 (push (widget-create-child-and-convert 2292 (insert "\n" (or doc-initial-string "Group documentation:") " ")
2292 widget (car links) 2293 (while links
2293 :button-face 'custom-link 2294 (push (widget-create-child-and-convert
2294 :mouse-face 'highlight 2295 widget (car links)
2295 :pressed-face 'highlight) 2296 :button-face 'custom-link
2296 buttons) 2297 :mouse-face 'highlight
2297 (setq links (cdr links)) 2298 :pressed-face 'highlight)
2298 (cond ((null links) 2299 buttons)
2299 (insert ".\n")) 2300 (setq links (cdr links))
2300 ((null (cdr links)) 2301 (cond ((null links)
2301 (if many 2302 (insert ".\n"))
2302 (insert ", and ") 2303 ((null (cdr links))
2303 (insert " and "))) 2304 (if many
2304 (t 2305 (insert ", and ")
2305 (insert ", "))))))) 2306 (insert " and ")))
2307 (t
2308 (insert ", "))))
2309 (fill-region-as-paragraph pt (point))
2310 (delete-to-left-margin (1+ pt) (+ pt 2))))))
2306 (if parents 2311 (if parents
2307 (insert "\n") 2312 (insert "\n")
2308 (delete-region start (point))) 2313 (delete-region start (point)))
@@ -3496,10 +3501,10 @@ Optional EVENT is the location for the menu."
3496 (put symbol 'customized-face value) 3501 (put symbol 'customized-face value)
3497 (custom-push-theme 'theme-face symbol 'user 'set value) 3502 (custom-push-theme 'theme-face symbol 'user 'set value)
3498 (if (face-spec-choose value) 3503 (if (face-spec-choose value)
3499 (face-spec-set symbol value) 3504 (face-spec-set symbol value t)
3500 ;; face-set-spec ignores empty attribute lists, so just give it 3505 ;; face-set-spec ignores empty attribute lists, so just give it
3501 ;; something harmless instead. 3506 ;; something harmless instead.
3502 (face-spec-set symbol '((t :foreground unspecified)))) 3507 (face-spec-set symbol '((t :foreground unspecified)) t))
3503 (put symbol 'customized-face-comment comment) 3508 (put symbol 'customized-face-comment comment)
3504 (put symbol 'face-comment comment) 3509 (put symbol 'face-comment comment)
3505 (custom-face-state-set widget) 3510 (custom-face-state-set widget)
@@ -3518,10 +3523,10 @@ Optional EVENT is the location for the menu."
3518 (custom-comment-hide comment-widget)) 3523 (custom-comment-hide comment-widget))
3519 (custom-push-theme 'theme-face symbol 'user 'set value) 3524 (custom-push-theme 'theme-face symbol 'user 'set value)
3520 (if (face-spec-choose value) 3525 (if (face-spec-choose value)
3521 (face-spec-set symbol value) 3526 (face-spec-set symbol value t)
3522 ;; face-set-spec ignores empty attribute lists, so just give it 3527 ;; face-set-spec ignores empty attribute lists, so just give it
3523 ;; something harmless instead. 3528 ;; something harmless instead.
3524 (face-spec-set symbol '((t :foreground unspecified)))) 3529 (face-spec-set symbol '((t :foreground unspecified)) t))
3525 (unless (eq (widget-get widget :custom-state) 'standard) 3530 (unless (eq (widget-get widget :custom-state) 'standard)
3526 (put symbol 'saved-face value)) 3531 (put symbol 'saved-face value))
3527 (put symbol 'customized-face nil) 3532 (put symbol 'customized-face nil)
@@ -3548,7 +3553,7 @@ Optional EVENT is the location for the menu."
3548 (put symbol 'customized-face nil) 3553 (put symbol 'customized-face nil)
3549 (put symbol 'customized-face-comment nil) 3554 (put symbol 'customized-face-comment nil)
3550 (custom-push-theme 'theme-face symbol 'user 'set value) 3555 (custom-push-theme 'theme-face symbol 'user 'set value)
3551 (face-spec-set symbol value) 3556 (face-spec-set symbol value t)
3552 (put symbol 'face-comment comment) 3557 (put symbol 'face-comment comment)
3553 (widget-value-set child value) 3558 (widget-value-set child value)
3554 ;; This call manages the comment visibility 3559 ;; This call manages the comment visibility
@@ -3572,7 +3577,7 @@ restoring it to the state of a face that has never been customized."
3572 (put symbol 'customized-face nil) 3577 (put symbol 'customized-face nil)
3573 (put symbol 'customized-face-comment nil) 3578 (put symbol 'customized-face-comment nil)
3574 (custom-push-theme 'theme-face symbol 'user 'reset) 3579 (custom-push-theme 'theme-face symbol 'user 'reset)
3575 (face-spec-set symbol value) 3580 (face-spec-set symbol value t)
3576 (custom-theme-recalc-face symbol) 3581 (custom-theme-recalc-face symbol)
3577 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) 3582 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
3578 (put symbol 'saved-face nil) 3583 (put symbol 'saved-face nil)
@@ -3894,7 +3899,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
3894 ;;; was made to display a group. 3899 ;;; was made to display a group.
3895 (when (eq level 1) 3900 (when (eq level 1)
3896 (if (custom-add-parent-links widget 3901 (if (custom-add-parent-links widget
3897 "Parent groups:") 3902 "Parent groups:"
3903 "Parent group documentation:")
3898 (insert "\n")))) 3904 (insert "\n"))))
3899 ;; Create level indicator. 3905 ;; Create level indicator.
3900 (insert-char ?\ (* custom-buffer-indent (1- level))) 3906 (insert-char ?\ (* custom-buffer-indent (1- level)))
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 92274dcbe21..dfc5babec84 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -46,7 +46,7 @@
46 (make-empty-face face) 46 (make-empty-face face)
47 ;; Create frame-local faces 47 ;; Create frame-local faces
48 (dolist (frame (frame-list)) 48 (dolist (frame (frame-list))
49 (face-spec-set face value frame) 49 (face-spec-set-2 face frame value)
50 (when (memq (window-system frame) '(x w32 mac)) 50 (when (memq (window-system frame) '(x w32 mac))
51 (setq have-window-system t))) 51 (setq have-window-system t)))
52 ;; When making a face after frames already exist 52 ;; When making a face after frames already exist
@@ -342,7 +342,8 @@ FACE's list property `theme-face' \(using `custom-push-theme')."
342 (unless (facep face) 342 (unless (facep face)
343 (make-empty-face face)) 343 (make-empty-face face))
344 (put face 'face-comment comment) 344 (put face 'face-comment comment)
345 (face-spec-set face spec nil)) 345 (put face 'face-override-spec nil)
346 (face-spec-set face spec t))
346 (setq args (cdr args))) 347 (setq args (cdr args)))
347 ;; Old format, a plist of FACE SPEC pairs. 348 ;; Old format, a plist of FACE SPEC pairs.
348 (let ((face (nth 0 args)) 349 (let ((face (nth 0 args))
diff --git a/lisp/custom.el b/lisp/custom.el
index bbee71ecf1f..d39bbb37e07 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1176,9 +1176,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
1176(defun custom-theme-recalc-face (face) 1176(defun custom-theme-recalc-face (face)
1177 "Set FACE according to currently enabled custom themes." 1177 "Set FACE according to currently enabled custom themes."
1178 (if (facep face) 1178 (if (facep face)
1179 (let ((theme-faces (reverse (get face 'theme-face)))) 1179 (face-spec-recalc face)))
1180 (dolist (spec theme-faces)
1181 (face-spec-set face (cadr spec))))))
1182 1180
1183;;; XEmacs compability functions 1181;;; XEmacs compability functions
1184 1182
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index c4ba3e4ca9c..0ef9cc89ba4 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -596,20 +596,39 @@ displayed."
596 symname))))) 596 symname)))))
597 elp-all-instrumented-list)) 597 elp-all-instrumented-list))
598 ) ; end let* 598 ) ; end let*
599 (insert title) 599 ;; If printing to stdout, insert the header so it will print.
600 (if (> longest titlelen) 600 ;; Otherwise use header-line-format.
601 (progn 601 (setq elp-field-len (max titlelen longest))
602 (insert-char 32 (- longest titlelen)) 602 (if (or elp-use-standard-output noninteractive)
603 (setq elp-field-len longest))) 603 (progn
604 (insert " " cc-header " " et-header " " at-header "\n") 604 (insert title)
605 (insert-char ?= elp-field-len) 605 (if (> longest titlelen)
606 (insert " ") 606 (progn
607 (insert-char ?= elp-cc-len) 607 (insert-char 32 (- longest titlelen))))
608 (insert " ") 608 (insert " " cc-header " " et-header " " at-header "\n")
609 (insert-char ?= elp-et-len) 609 (insert-char ?= elp-field-len)
610 (insert " ") 610 (insert " ")
611 (insert-char ?= elp-at-len) 611 (insert-char ?= elp-cc-len)
612 (insert "\n") 612 (insert " ")
613 (insert-char ?= elp-et-len)
614 (insert " ")
615 (insert-char ?= elp-at-len)
616 (insert "\n"))
617 (let ((column 0))
618 (setq header-line-format
619 (mapconcat
620 (lambda (title)
621 (prog1
622 (concat
623 (propertize " "
624 'display (list 'space :align-to column)
625 'face 'fixed-pitch)
626 title)
627 (setq column (+ column 1
628 (if (= column 0)
629 elp-field-len
630 (length title))))))
631 (list title cc-header et-header at-header) ""))))
613 ;; if sorting is enabled, then sort the results list. in either 632 ;; if sorting is enabled, then sort the results list. in either
614 ;; case, call elp-output-result to output the result in the 633 ;; case, call elp-output-result to output the result in the
615 ;; buffer 634 ;; buffer
@@ -621,7 +640,8 @@ displayed."
621 (pop-to-buffer resultsbuf) 640 (pop-to-buffer resultsbuf)
622 ;; copy results to standard-output? 641 ;; copy results to standard-output?
623 (if (or elp-use-standard-output noninteractive) 642 (if (or elp-use-standard-output noninteractive)
624 (princ (buffer-substring (point-min) (point-max)))) 643 (princ (buffer-substring (point-min) (point-max)))
644 (goto-char (point-min)))
625 ;; reset profiling info if desired 645 ;; reset profiling info if desired
626 (and elp-reset-after-results 646 (and elp-reset-after-results
627 (elp-reset-all)))) 647 (elp-reset-all))))
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 968a115c5d1..61a6f52f55b 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -541,14 +541,14 @@ argument BUFFER-NAME is nil, it defaults to *Colors*."
541 (insert (car color)) 541 (insert (car color))
542 (indent-to 22)) 542 (indent-to 22))
543 (point) 543 (point)
544 'face (cons 'background-color (car color))) 544 'face (list ':background (car color)))
545 (put-text-property 545 (put-text-property
546 (prog1 (point) 546 (prog1 (point)
547 (insert " " (if (cdr color) 547 (insert " " (if (cdr color)
548 (mapconcat 'identity (cdr color) ", ") 548 (mapconcat 'identity (cdr color) ", ")
549 (car color)))) 549 (car color))))
550 (point) 550 (point)
551 'face (cons 'foreground-color (car color))) 551 'face (list ':foreground (car color)))
552 (indent-to (max (- (window-width) 8) 44)) 552 (indent-to (max (- (window-width) 8) 44))
553 (insert (apply 'format "#%02x%02x%02x" 553 (insert (apply 'format "#%02x%02x%02x"
554 (mapcar (lambda (c) (lsh c -8)) 554 (mapcar (lambda (c) (lsh c -8))
diff --git a/lisp/faces.el b/lisp/faces.el
index 75fe47022a2..11d9ba7b8eb 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -276,10 +276,8 @@ The optional argument FRAME is ignored."
276;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 276;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
277 277
278(defun facep (face) 278(defun facep (face)
279 "Return non-nil if FACE is a face name or internal face object. 279 "Return non-nil if FACE is a face name; nil otherwise.
280Return nil otherwise. A face name can be a string or a symbol. 280A face name can be a string or a symbol."
281An internal face object is a vector of the kind used internally
282to record face data."
283 (internal-lisp-face-p face)) 281 (internal-lisp-face-p face))
284 282
285 283
@@ -319,9 +317,7 @@ If the optional argument FRAME is given, report on face FACE in that frame.
319If FRAME is t, report on the defaults for face FACE (for new frames). 317If FRAME is t, report on the defaults for face FACE (for new frames).
320If FRAME is omitted or nil, use the selected frame." 318If FRAME is omitted or nil, use the selected frame."
321 (let ((attrs 319 (let ((attrs
322 '(:family :width :height :weight :slant :foreground 320 (delq :inherit (mapcar 'car face-attribute-name-alist)))
323 :background :underline :overline :strike-through
324 :box :inverse-video))
325 (differs nil)) 321 (differs nil))
326 (while (and attrs (not differs)) 322 (while (and attrs (not differs))
327 (let* ((attr (pop attrs)) 323 (let* ((attr (pop attrs))
@@ -423,6 +419,17 @@ FRAME nil or not specified means do it for all frames."
423 (symbol-name (check-face face))) 419 (symbol-name (check-face face)))
424 420
425 421
422(defun face-all-attributes (face &optional frame)
423 "Return an alist stating the attributes of FACE.
424Each element of the result has the form (ATTR-NAME . ATTR-VALUE).
425Normally the value describes the default attributes,
426but if you specify FRAME, the value describes the attributes
427of FACE on FRAME."
428 (mapcar (lambda (pair)
429 (let ((attr (car pair)))
430 (cons attr (face-attribute face attr (or frame t)))))
431 face-attribute-name-alist))
432
426(defun face-attribute (face attribute &optional frame inherit) 433(defun face-attribute (face attribute &optional frame inherit)
427 "Return the value of FACE's ATTRIBUTE on FRAME. 434 "Return the value of FACE's ATTRIBUTE on FRAME.
428If the optional argument FRAME is given, report on face FACE in that frame. 435If the optional argument FRAME is given, report on face FACE in that frame.
@@ -1516,46 +1523,79 @@ If SPEC is nil, return nil."
1516 (setq attrs (cdr attrs))))) 1523 (setq attrs (cdr attrs)))))
1517 1524
1518 1525
1519(defun face-spec-set (face spec &optional frame) 1526(defun face-spec-set (face spec &optional for-defface)
1520 "Set FACE's attributes according to the first matching entry in SPEC. 1527 "Set FACE's face spec, which controls its appearance, to SPEC>
1521FRAME is the frame whose frame-local face is set. FRAME nil means 1528If FOR-DEFFACE is t, set the base spec, the one that `defface'
1522do it on all frames (and change the default for new frames). 1529 and Custom set. (In that case, the caller must put it in the
1523See `defface' for information about SPEC. If SPEC is nil, do nothing." 1530 appropriate property, because that depends on the caller.)
1524 (let ((attrs (face-spec-choose spec frame))) 1531If FOR-DEFFACE is nil, set the overriding spec (and store it
1525 (when spec 1532 in the `face-override-spec' property of FACE).
1526 (face-spec-reset-face face (or frame t))) 1533
1527 (while attrs 1534The appearance of FACE is controlled by the base spec,
1528 (let ((attribute (car attrs)) 1535by any custom theme specs on top of that, and by the
1529 (value (car (cdr attrs)))) 1536the overriding spec on top of all the rest.
1530 ;; Support some old-style attribute names and values. 1537
1531 (case attribute 1538FOR-DEFFACE can also be a frame, in which case we set the
1532 (:bold (setq attribute :weight value (if value 'bold 'normal))) 1539frame-specific attributes of FACE for that frame based on SPEC.
1533 (:italic (setq attribute :slant value (if value 'italic 'normal))) 1540That usage is deprecated.
1534 ((:foreground :background) 1541
1535 ;; Compatibility with 20.x. Some bogus face specs seem to 1542See `defface' for information about the format and meaning of SPEC."
1536 ;; exist containing things like `:foreground nil'. 1543 (if (framep for-defface)
1537 (if (null value) (setq value 'unspecified))) 1544 ;; Handle the deprecated case where third arg is a frame.
1538 (t (unless (assq attribute face-x-resources) 1545 (face-spec-set-2 face for-defface spec)
1539 (setq attribute nil)))) 1546 (if for-defface
1540 (when attribute 1547 ;; When we reset the face based on its custom spec, then it is
1541 ;; If frame is nil, set the default for new frames. 1548 ;; unmodified as far as Custom is concerned.
1542 ;; Existing frames are handled below. 1549 (put (or (get face 'face-alias) face) 'face-modified nil)
1543 (set-face-attribute face (or frame t) attribute value))) 1550 ;; When we change a face based on a spec from outside custom,
1544 (setq attrs (cdr (cdr attrs))))) 1551 ;; record it for future frames.
1545 (unless frame 1552 (put (or (get face 'face-alias) face) 'face-override-spec spec))
1546 ;; When we reset the face based on its spec, then it is unmodified 1553;;; RMS 29 dec 2007: Perhaps this code should be reinstated.
1547 ;; as far as Custom is concerned. 1554;;; That depends on whether the overriding spec
1548 (put (or (get face 'face-alias) face) 'face-modified nil) 1555;;; or the default face attributes
1549;;; ;; Clear all the new-frame defaults for this face. 1556;;; should take priority.
1557;;; ;; Clear all the new-frame default attributes for this face.
1550;;; ;; face-spec-reset-face won't do it right. 1558;;; ;; face-spec-reset-face won't do it right.
1551;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) 1559;;; (let ((facevec (cdr (assq face face-new-frame-defaults))))
1552;;; (dotimes (i (length facevec)) 1560;;; (dotimes (i (length facevec))
1553;;; (unless (= i 0) 1561;;; (unless (= i 0)
1554;;; (aset facevec i 'unspecified)))) 1562;;; (aset facevec i 'unspecified))))
1555 ;; Set each frame according to the rules implied by SPEC. 1563 ;; Reset each frame according to the rules implied by all its specs.
1556 (dolist (frame (frame-list)) 1564 (dolist (frame (frame-list))
1557 (face-spec-set face spec frame)))) 1565 (face-spec-recalc face frame))))
1558 1566
1567(defun face-spec-recalc (face frame)
1568 "Reset the face attributes of FACE on FRAME according to its specs.
1569This applies the defface/custom spec first, then the custom theme specs,
1570then the override spec."
1571 (face-spec-reset-face face frame)
1572 (let ((face-sym (or (get face 'face-alias) face)))
1573 (face-spec-set-2 face frame
1574 (face-user-default-spec face))
1575 (let ((theme-faces (reverse (get face-sym 'theme-face))))
1576 (dolist (spec theme-faces)
1577 (face-spec-set-2 face frame (cadr spec))))
1578 (face-spec-set-2 face frame (get face-sym 'face-override-spec))))
1579
1580(defun face-spec-set-2 (face frame spec)
1581 "Set the face attributes of FACE on FRAME according to SPEC."
1582 (let* ((attrs (face-spec-choose spec frame)))
1583 (while attrs
1584 (let ((attribute (car attrs))
1585 (value (car (cdr attrs))))
1586 ;; Support some old-style attribute names and values.
1587 (case attribute
1588 (:bold (setq attribute :weight value (if value 'bold 'normal)))
1589 (:italic (setq attribute :slant value (if value 'italic 'normal)))
1590 ((:foreground :background)
1591 ;; Compatibility with 20.x. Some bogus face specs seem to
1592 ;; exist containing things like `:foreground nil'.
1593 (if (null value) (setq value 'unspecified)))
1594 (t (unless (assq attribute face-x-resources)
1595 (setq attribute nil))))
1596 (when attribute
1597 (set-face-attribute face frame attribute value)))
1598 (setq attrs (cdr (cdr attrs))))))
1559 1599
1560(defun face-attr-match-p (face attrs &optional frame) 1600(defun face-attr-match-p (face attrs &optional frame)
1561 "Return t if attributes of FACE match values in plist ATTRS. 1601 "Return t if attributes of FACE match values in plist ATTRS.
@@ -1868,14 +1908,16 @@ according to the `background-mode' and `display-type' frame parameters."
1868 (let ((locally-modified-faces nil)) 1908 (let ((locally-modified-faces nil))
1869 ;; Before modifying the frame parameters, we collect a list of 1909 ;; Before modifying the frame parameters, we collect a list of
1870 ;; faces that don't match what their face-spec says they should 1910 ;; faces that don't match what their face-spec says they should
1871 ;; look like; we then avoid changing these faces below. A 1911 ;; look like; we then avoid changing these faces below.
1872 ;; negative list is used on the assumption that most faces will 1912 ;; These are the faces whose attributes were modified on FRAME.
1913 ;; We use a negative list on the assumption that most faces will
1873 ;; be unmodified, so we can avoid consing in the common case. 1914 ;; be unmodified, so we can avoid consing in the common case.
1874 (dolist (face (face-list)) 1915 (dolist (face (face-list))
1875 (when (not (face-spec-match-p face 1916 (and (not (get face 'face-override-spec))
1876 (face-user-default-spec face) 1917 (not (face-spec-match-p face
1877 (selected-frame))) 1918 (face-user-default-spec face)
1878 (push face locally-modified-faces))) 1919 (selected-frame)))
1920 (push face locally-modified-faces)))
1879 ;; Now change to the new frame parameters 1921 ;; Now change to the new frame parameters
1880 (modify-frame-parameters frame 1922 (modify-frame-parameters frame
1881 (list (cons 'background-mode bg-mode) 1923 (list (cons 'background-mode bg-mode)
@@ -1884,7 +1926,7 @@ according to the `background-mode' and `display-type' frame parameters."
1884 ;; parameters, unless they have been locally modified. 1926 ;; parameters, unless they have been locally modified.
1885 (dolist (face (face-list)) 1927 (dolist (face (face-list))
1886 (unless (memq face locally-modified-faces) 1928 (unless (memq face locally-modified-faces)
1887 (face-spec-set face (face-user-default-spec face) frame))))))) 1929 (face-spec-recalc face frame)))))))
1888 1930
1889 1931
1890;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1932;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2018,7 +2060,7 @@ Initialize colors of certain faces from frame parameters."
2018 (dolist (face (delq 'default (face-list))) 2060 (dolist (face (delq 'default (face-list)))
2019 (condition-case () 2061 (condition-case ()
2020 (progn 2062 (progn
2021 (face-spec-set face (face-user-default-spec face) frame) 2063 (face-spec-recalc face frame)
2022 (if (memq (window-system frame) '(x w32 mac)) 2064 (if (memq (window-system frame) '(x w32 mac))
2023 (make-face-x-resource-internal face frame)) 2065 (make-face-x-resource-internal face frame))
2024 (internal-merge-in-global-face face frame)) 2066 (internal-merge-in-global-face face frame))
diff --git a/lisp/files.el b/lisp/files.el
index dec47ce362e..75dfb089c51 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -635,10 +635,10 @@ Directories are separated by occurrences of `path-separator'
635 (if (file-exists-p dir) 635 (if (file-exists-p dir)
636 (error "%s is not a directory" dir) 636 (error "%s is not a directory" dir)
637 (error "%s: no such directory" dir)) 637 (error "%s: no such directory" dir))
638 (if (file-executable-p dir) 638 (unless (file-executable-p dir)
639 (setq default-directory dir 639 (error "Cannot cd to %s: Permission denied" dir))
640 list-buffers-directory dir) 640 (setq default-directory dir)
641 (error "Cannot cd to %s: Permission denied" dir)))) 641 (set (make-local-variable 'list-buffers-directory) dir)))
642 642
643(defun cd (dir) 643(defun cd (dir)
644 "Make DIR become the current buffer's default directory. 644 "Make DIR become the current buffer's default directory.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index f7cc4da0aae..147b98f5a55 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1303,6 +1303,12 @@ Optional argument OBJECT is the string or buffer containing the text."
1303 (while (/= start end) 1303 (while (/= start end)
1304 (setq next (next-single-property-change start prop object end) 1304 (setq next (next-single-property-change start prop object end)
1305 prev (get-text-property start prop object)) 1305 prev (get-text-property start prop object))
1306 ;; Canonicalize old forms of face property.
1307 (and (memq prop '(face font-lock-face))
1308 (listp prev)
1309 (or (keywordp (car prev))
1310 (memq (car prev) '(foreground-color background-color)))
1311 (setq prev (list prev)))
1306 (put-text-property start next prop 1312 (put-text-property start next prop
1307 (append val (if (listp prev) prev (list prev))) 1313 (append val (if (listp prev) prev (list prev)))
1308 object) 1314 object)
@@ -1317,6 +1323,12 @@ Optional argument OBJECT is the string or buffer containing the text."
1317 (while (/= start end) 1323 (while (/= start end)
1318 (setq next (next-single-property-change start prop object end) 1324 (setq next (next-single-property-change start prop object end)
1319 prev (get-text-property start prop object)) 1325 prev (get-text-property start prop object))
1326 ;; Canonicalize old forms of face property.
1327 (and (memq prop '(face font-lock-face))
1328 (listp prev)
1329 (or (keywordp (car prev))
1330 (memq (car prev) '(foreground-color background-color)))
1331 (setq prev (list prev)))
1320 (put-text-property start next prop 1332 (put-text-property start next prop
1321 (append (if (listp prev) prev (list prev)) val) 1333 (append (if (listp prev) prev (list prev)) val)
1322 object) 1334 object)
diff --git a/lisp/man.el b/lisp/man.el
index 48639cd764b..1f4288bc803 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -642,50 +642,91 @@ a new value."
642 642
643 643
644;; ====================================================================== 644;; ======================================================================
645;; default man entry: get word under point 645;; default man entry: get word near point
646 646
647(defsubst Man-default-man-entry (&optional pos) 647(defun Man-default-man-entry (&optional pos)
648 "Make a guess at a default manual entry based on the text at POS. 648 "Guess default manual entry based on the text near position POS.
649If POS is nil, the current point is used." 649POS defaults to `point'."
650 (let (word start original-pos distance) 650 (let (word start pos column distance)
651 (save-excursion 651 (save-excursion
652 (if pos (goto-char pos)) 652 (when pos (goto-char pos))
653 ;; Default man entry title is any word the cursor is on, or if 653 (setq pos (point))
654 ;; cursor not on a word, nearest preceding or next word-like 654 ;; The default title is the nearest entry-like object before or
655 ;; object on this line. 655 ;; after POS.
656 (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) 656 (if (and (skip-chars-backward " \ta-zA-Z0-9+")
657 (not (zerop (skip-chars-backward "(")))
658 ;; Try to handle the special case where POS is on a
659 ;; section number.
660 (looking-at
661 (concat "([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
662 ;; We skipped a valid section number backwards, look at
663 ;; preceding text.
664 (or (and (skip-chars-backward ",; \t")
665 (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))))
666 ;; Not a valid entry, move POS after closing paren.
667 (not (setq pos (match-end 0)))))
668 ;; We have a candidate, make `start' record its starting
669 ;; position.
657 (setq start (point)) 670 (setq start (point))
658 (setq original-pos (point)) 671 ;; Otherwise look at char before POS.
659 (setq distance (abs (skip-chars-backward ",; \t"))) 672 (goto-char pos)
660 (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) 673 (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
661 (progn 674 ;; Our candidate is just before or around POS.
662 (setq start (point)) 675 (setq start (point))
663 (goto-char original-pos) 676 ;; Otherwise record the current column and look backwards.
664 (if (and (< (skip-chars-forward ",; \t") distance) 677 (setq column (current-column))
665 (looking-at "[-a-zA-Z0-9._+:]")) 678 (skip-chars-backward ",; \t")
666 (setq start (point)) 679 ;; Record the distance travelled.
667 (goto-char start))) 680 (setq distance (- column (current-column)))
668 (skip-chars-forward ",; \t") 681 (when (looking-back
669 (setq start (point)))) 682 (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)"))
683 ;; Skip section number backwards.
684 (goto-char (match-beginning 0))
685 (skip-chars-backward " \t"))
686 (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
687 (progn
688 ;; We have a candidate before POS ...
689 (setq start (point))
690 (goto-char pos)
691 (if (and (skip-chars-forward ",; \t")
692 (< (- (current-column) column) distance)
693 (looking-at "[-a-zA-Z0-9._+:]"))
694 ;; ... but the one after POS is better.
695 (setq start (point))
696 ;; ... and anything after POS is worse.
697 (goto-char start)))
698 ;; No candidate before POS.
699 (goto-char pos)
700 (skip-chars-forward ",; \t")
701 (setq start (point)))))
702 ;; We have found a suitable starting point, try to skip at least
703 ;; one character.
670 (skip-chars-forward "-a-zA-Z0-9._+:") 704 (skip-chars-forward "-a-zA-Z0-9._+:")
671 (setq word (buffer-substring-no-properties start (point))) 705 (setq word (buffer-substring-no-properties start (point)))
672 ;; If there is a continuation at the end of line, check the 706 ;; If there is a continuation at the end of line, check the
673 ;; following line too, eg: 707 ;; following line too, eg:
674 ;; see this- 708 ;; see this-
675 ;; command-here(1) 709 ;; command-here(1)
710 ;; Note: This code gets executed iff our entry is after POS.
676 (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") 711 (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])")
677 (setq word (concat word (match-string-no-properties 1)))) 712 (setq word (concat word (match-string-no-properties 1)))
713 ;; Make sure the section number gets included by the code below.
714 (goto-char (match-end 1)))
678 (when (string-match "[._]+$" word) 715 (when (string-match "[._]+$" word)
679 (setq word (substring word 0 (match-beginning 0)))) 716 (setq word (substring word 0 (match-beginning 0))))
680 ;; If looking at something like *strcat(... , remove the '*' 717 ;; The following was commented out since the preceding code
681 (when (string-match "^*" word) 718 ;; should not produce a leading "*" in the first place.
682 (setq word (substring word 1))) 719;;; ;; If looking at something like *strcat(... , remove the '*'
683 ;; If looking at something like ioctl(2) or brc(1M), include the 720;;; (when (string-match "^*" word)
684 ;; section number in the returned value. Remove text properties. 721;;; (setq word (substring word 1)))
685 (concat word 722 (concat
686 (if (looking-at 723 word
687 (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) 724 (and (not (string-equal word ""))
688 (format "(%s)" (match-string-no-properties 1))))))) 725 ;; If looking at something like ioctl(2) or brc(1M),
726 ;; include the section number in the returned value.
727 (looking-at
728 (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
729 (format "(%s)" (match-string-no-properties 1)))))))
689 730
690 731
691;; ====================================================================== 732;; ======================================================================
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 75bcb8ed138..1c1016aed97 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -64,33 +64,50 @@ hash table."
64 dbus-registered-functions-table) 64 dbus-registered-functions-table)
65 result)) 65 result))
66 66
67(defun dbus-name-owner-changed-handler (service old-owner new-owner) 67(defun dbus-name-owner-changed-handler (&rest args)
68 "Reapplies all signal registrations to D-Bus. 68 "Reapplies all signal registrations to D-Bus.
69This handler is applied when a \"NameOwnerChanged\" signal has 69This handler is applied when a \"NameOwnerChanged\" signal has
70arrived. SERVICE is the object name for which the name owner has 70arrived. SERVICE is the object name for which the name owner has
71been changed. OLD-OWNER is the previous owner of SERVICE, or the 71been changed. OLD-OWNER is the previous owner of SERVICE, or the
72empty string if SERVICE was not owned yet. NEW-OWNER is the new 72empty string if SERVICE was not owned yet. NEW-OWNER is the new
73owner of SERVICE, or the empty string if SERVICE looses any name owner." 73owner of SERVICE, or the empty string if SERVICE looses any name owner.
74
75usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
74 (save-match-data 76 (save-match-data
75 ;; Check whether SERVICE is a known name. 77 ;; Check the arguments. We should silently ignore it when they
76 (when (and (stringp service) (not (string-match "^:" service)) 78 ;; are wrong.
77 (stringp old-owner) (stringp new-owner)) 79 (if (and (= (length args) 3)
78 (maphash 80 (stringp (car args))
79 '(lambda (key value) 81 (stringp (cadr args))
80 (dolist (elt value) 82 (stringp (caddr args)))
81 ;; key has the structure (BUS INTERFACE SIGNAL). 83 (let ((service (car args))
82 ;; elt has the structure (UNAME SERVICE PATH HANDLER). 84 (old-owner (cadr args))
83 (when (string-equal old-owner (car elt)) 85 (new-owner (caddr args)))
84 ;; Remove old key, and add new entry with changed name. 86 ;; Check whether SERVICE is a known name.
85 (dbus-unregister-signal (list key (cdr elt))) 87 (when (not (string-match "^:" service))
86 ;; Maybe we could arrange the lists a little bit better 88 (maphash
87 ;; that we don't need to extract every single element? 89 '(lambda (key value)
88 (dbus-register-signal 90 (dolist (elt value)
89 ;; BUS SERVICE PATH 91 ;; key has the structure (BUS INTERFACE SIGNAL).
90 (nth 0 key) (nth 1 elt) (nth 2 elt) 92 ;; elt has the structure (UNAME SERVICE PATH HANDLER).
91 ;; INTERFACE SIGNAL HANDLER 93 (when (string-equal old-owner (car elt))
92 (nth 1 key) (nth 2 key) (nth 3 elt))))) 94 ;; Remove old key, and add new entry with changed name.
93 (copy-hash-table dbus-registered-functions-table))))) 95 (dbus-unregister-signal (list key (cdr elt)))
96 ;; Maybe we could arrange the lists a little bit better
97 ;; that we don't need to extract every single element?
98 (dbus-register-signal
99 ;; BUS SERVICE PATH
100 (nth 0 key) (nth 1 elt) (nth 2 elt)
101 ;; INTERFACE SIGNAL HANDLER
102 (nth 1 key) (nth 2 key) (nth 3 elt)))))
103 (copy-hash-table dbus-registered-functions-table))))
104 ;; The error is reported only in debug mode.
105 (when dbus-debug
106 (signal
107 'dbus-error
108 (cons
109 (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
110 args))))))
94 111
95;; Register the handler. 112;; Register the handler.
96(condition-case nil 113(condition-case nil
@@ -148,11 +165,11 @@ part of the event, is called with arguments ARGS."
148 (interactive "e") 165 (interactive "e")
149 ;; We don't want to raise an error, because this function is called 166 ;; We don't want to raise an error, because this function is called
150 ;; in the event handling loop. 167 ;; in the event handling loop.
151 (condition-case nil 168 (condition-case err
152 (progn 169 (progn
153 (dbus-check-event event) 170 (dbus-check-event event)
154 (apply (nth 6 event) (nthcdr 7 event))) 171 (apply (nth 6 event) (nthcdr 7 event)))
155 (dbus-error))) 172 (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
156 173
157(defun dbus-event-bus-name (event) 174(defun dbus-event-bus-name (event)
158 "Return the bus name the event is coming from. 175 "Return the bus name the event is coming from.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index a1a0e0ca8e9..06e5c1ad678 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1480,32 +1480,47 @@ record activity."
1480 (run-hook-with-args 'rcirc-print-hooks 1480 (run-hook-with-args 'rcirc-print-hooks
1481 process sender response target text))))) 1481 process sender response target text)))))
1482 1482
1483(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name
1484 "A function to generate the filename used by rcirc's logging facility.
1485
1486It is called with two arguments, PROCESS and TARGET (see
1487`rcirc-generate-new-buffer-name' for their meaning), and should
1488return the filename, or nil if no logging is desired for this
1489session.
1490
1491If the returned filename is absolute (`file-name-absolute-p'
1492returns true), then it is used as-is, otherwise the resulting
1493file is put into `rcirc-log-directory'."
1494 :group 'rcirc
1495 :type 'function)
1496
1483(defun rcirc-log (process sender response target text) 1497(defun rcirc-log (process sender response target text)
1484 "Record line in `rcirc-log', to be later written to disk." 1498 "Record line in `rcirc-log', to be later written to disk."
1485 (let* ((filename (rcirc-generate-new-buffer-name process target)) 1499 (let ((filename (funcall rcirc-log-filename-function process target)))
1486 (cell (assoc-string filename rcirc-log-alist)) 1500 (unless (null filename)
1487 (line (concat (format-time-string rcirc-time-format) 1501 (let ((cell (assoc-string filename rcirc-log-alist))
1488 (substring-no-properties 1502 (line (concat (format-time-string rcirc-time-format)
1489 (rcirc-format-response-string process sender 1503 (substring-no-properties
1490 response target text)) 1504 (rcirc-format-response-string process sender
1491 "\n"))) 1505 response target text))
1492 (if cell 1506 "\n")))
1493 (setcdr cell (concat (cdr cell) line)) 1507 (if cell
1494 (setq rcirc-log-alist 1508 (setcdr cell (concat (cdr cell) line))
1495 (cons (cons filename line) rcirc-log-alist))))) 1509 (setq rcirc-log-alist
1510 (cons (cons filename line) rcirc-log-alist)))))))
1496 1511
1497(defun rcirc-log-write () 1512(defun rcirc-log-write ()
1498 "Flush `rcirc-log-alist' data to disk. 1513 "Flush `rcirc-log-alist' data to disk.
1499 1514
1500Log data is written to `rcirc-log-directory'." 1515Log data is written to `rcirc-log-directory', except for
1501 (make-directory rcirc-log-directory t) 1516log-files with absolute names (see `rcirc-log-filename-function')."
1502 (dolist (cell rcirc-log-alist) 1517 (dolist (cell rcirc-log-alist)
1503 (with-temp-buffer 1518 (let ((filename (expand-file-name (car cell) rcirc-log-directory))
1504 (insert (cdr cell)) 1519 (coding-system-for-write 'utf-8))
1505 (let ((coding-system-for-write 'utf-8)) 1520 (make-directory (file-name-directory filename) t)
1506 (write-region (point-min) (point-max) 1521 (with-temp-buffer
1507 (concat rcirc-log-directory "/" (car cell)) 1522 (insert (cdr cell))
1508 t 'quiet)))) 1523 (write-region (point-min) (point-max) filename t 'quiet))))
1509 (setq rcirc-log-alist nil)) 1524 (setq rcirc-log-alist nil))
1510 1525
1511(defun rcirc-join-channels (process channels) 1526(defun rcirc-join-channels (process channels)
diff --git a/lisp/startup.el b/lisp/startup.el
index 3483e158429..8ab50efa877 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1157,7 +1157,7 @@ regardless of the value of this variable."
1157;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1157;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1158 1158
1159(defvar fancy-startup-text 1159(defvar fancy-startup-text
1160 '((:face (variable-pitch :foreground "red") 1160 '((:face (variable-pitch (:foreground "red"))
1161 "Welcome to " 1161 "Welcome to "
1162 :link ("GNU Emacs" 1162 :link ("GNU Emacs"
1163 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) 1163 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1203,7 +1203,7 @@ regardless of the value of this variable."
1203 "\tView the Emacs manual using Info\n" 1203 "\tView the Emacs manual using Info\n"
1204 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) 1204 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
1205 "\tGNU Emacs comes with " 1205 "\tGNU Emacs comes with "
1206 :face (variable-pitch :slant oblique) 1206 :face (variable-pitch (:slant oblique))
1207 "ABSOLUTELY NO WARRANTY\n" 1207 "ABSOLUTELY NO WARRANTY\n"
1208 :face variable-pitch 1208 :face variable-pitch
1209 :link ("Copying Conditions" (lambda (button) (describe-copying))) 1209 :link ("Copying Conditions" (lambda (button) (describe-copying)))
@@ -1216,7 +1216,7 @@ Each element in the list should be a list of strings or pairs
1216`:face FACE', like `fancy-splash-insert' accepts them.") 1216`:face FACE', like `fancy-splash-insert' accepts them.")
1217 1217
1218(defvar fancy-about-text 1218(defvar fancy-about-text
1219 '((:face (variable-pitch :foreground "red") 1219 '((:face (variable-pitch (:foreground "red"))
1220 "This is " 1220 "This is "
1221 :link ("GNU Emacs" 1221 :link ("GNU Emacs"
1222 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) 1222 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1232,13 +1232,14 @@ Each element in the list should be a list of strings or pairs
1232 "Display info on the GNU project."))) 1232 "Display info on the GNU project.")))
1233 " operating system.\n" 1233 " operating system.\n"
1234 :face (lambda () 1234 :face (lambda ()
1235 (list 'variable-pitch :foreground 1235 (list 'variable-pitch
1236 (if (eq (frame-parameter nil 'background-mode) 'dark) 1236 (list :foreground
1237 "cyan" "darkblue"))) 1237 (if (eq (frame-parameter nil 'background-mode) 'dark)
1238 "cyan" "darkblue"))))
1238 "\n" 1239 "\n"
1239 (lambda () (emacs-version)) 1240 (lambda () (emacs-version))
1240 "\n" 1241 "\n"
1241 :face (variable-pitch :height 0.5) 1242 :face (variable-pitch (:height 0.5))
1242 (lambda () emacs-copyright) 1243 (lambda () emacs-copyright)
1243 "\n\n" 1244 "\n\n"
1244 :face variable-pitch 1245 :face variable-pitch
@@ -1257,7 +1258,7 @@ Each element in the list should be a list of strings or pairs
1257 "\tWhy we developed GNU Emacs, and the GNU operating system\n" 1258 "\tWhy we developed GNU Emacs, and the GNU operating system\n"
1258 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) 1259 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
1259 "\tGNU Emacs comes with " 1260 "\tGNU Emacs comes with "
1260 :face (variable-pitch :slant oblique) 1261 :face (variable-pitch (:slant oblique))
1261 "ABSOLUTELY NO WARRANTY\n" 1262 "ABSOLUTELY NO WARRANTY\n"
1262 :face variable-pitch 1263 :face variable-pitch
1263 :link ("Copying Conditions" (lambda (button) (describe-copying))) 1264 :link ("Copying Conditions" (lambda (button) (describe-copying)))
@@ -1411,11 +1412,11 @@ a face or button specification."
1411 (lambda (button) (customize-group 'initialization)) 1412 (lambda (button) (customize-group 'initialization))
1412 "Change initialization settings including this screen") 1413 "Change initialization settings including this screen")
1413 "\n")) 1414 "\n"))
1414 (fancy-splash-insert :face `(variable-pitch :foreground ,fg) 1415 (fancy-splash-insert :face `(variable-pitch (:foreground ,fg))
1415 "\nThis is " 1416 "\nThis is "
1416 (emacs-version) 1417 (emacs-version)
1417 "\n" 1418 "\n"
1418 :face '(variable-pitch :height 0.5) 1419 :face '(variable-pitch (:height 0.5))
1419 emacs-copyright 1420 emacs-copyright
1420 "\n") 1421 "\n")
1421 (and auto-save-list-file-prefix 1422 (and auto-save-list-file-prefix
@@ -1431,12 +1432,12 @@ a face or button specification."
1431 (regexp-quote (file-name-nondirectory 1432 (regexp-quote (file-name-nondirectory
1432 auto-save-list-file-prefix))) 1433 auto-save-list-file-prefix)))
1433 t) 1434 t)
1434 (fancy-splash-insert :face '(variable-pitch :foreground "red") 1435 (fancy-splash-insert :face '(variable-pitch (:foreground "red"))
1435 "\nIf an Emacs session crashed recently, " 1436 "\nIf an Emacs session crashed recently, "
1436 "type " 1437 "type "
1437 :face '(fixed-pitch :foreground "red") 1438 :face '(fixed-pitch :foreground "red")
1438 "Meta-x recover-session RET" 1439 "Meta-x recover-session RET"
1439 :face '(variable-pitch :foreground "red") 1440 :face '(variable-pitch (:foreground "red"))
1440 "\nto recover" 1441 "\nto recover"
1441 " the files you were editing.")) 1442 " the files you were editing."))
1442 1443
@@ -1471,7 +1472,7 @@ a face or button specification."
1471 (overlay-put button 'checked t) 1472 (overlay-put button 'checked t)
1472 (overlay-put button 'display (overlay-get button :on-glyph)) 1473 (overlay-put button 'display (overlay-get button :on-glyph))
1473 (setq startup-screen-inhibit-startup-screen t))))) 1474 (setq startup-screen-inhibit-startup-screen t)))))
1474 (fancy-splash-insert :face '(variable-pitch :height 0.9) 1475 (fancy-splash-insert :face '(variable-pitch (:height 0.9))
1475 " Never show it again."))))) 1476 " Never show it again.")))))
1476 1477
1477(defun exit-splash-screen () 1478(defun exit-splash-screen ()
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0e3f9dffada..65153c3bb5d 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -336,12 +336,17 @@ Always stores Fcc copy of message when nil."
336 :group 'ispell) 336 :group 'ispell)
337 337
338 338
339(defcustom ispell-grep-command "egrep" 339(defcustom ispell-grep-command
340 ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they
341 ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options
342 ;; below).
343 (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep")
340 "Name of the grep command for search processes." 344 "Name of the grep command for search processes."
341 :type 'string 345 :type 'string
342 :group 'ispell) 346 :group 'ispell)
343 347
344(defcustom ispell-grep-options "-i" 348(defcustom ispell-grep-options
349 (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i")
345 "String of options to use when running the program in `ispell-grep-command'. 350 "String of options to use when running the program in `ispell-grep-command'.
346Should probably be \"-i\" or \"-e\". 351Should probably be \"-i\" or \"-e\".
347Some machines (like the NeXT) don't support \"-i\"" 352Some machines (like the NeXT) don't support \"-i\""
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 395145fd53b..5728497ed6c 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -93,6 +93,10 @@ When it reaches that size (in bytes), a warning is sent."
93 :type 'integer 93 :type 'integer
94 :group 'thumbs) 94 :group 'thumbs)
95 95
96;; Unfortunately Windows XP has a program called CONVERT.EXE in
97;; C:/WINDOWS/SYSTEM32/ for partioning NTFS system. So Emacs
98;; can find the one in your ImageMagick directory, you need to
99;; customize this value to the absolute filename.
96(defcustom thumbs-conversion-program 100(defcustom thumbs-conversion-program
97 (if (eq system-type 'windows-nt) 101 (if (eq system-type 'windows-nt)
98 "convert.exe" 102 "convert.exe"
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index 01599c91dff..8a1c56490ac 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -522,7 +522,7 @@ Optional argument LOCALP is always ignored."
522 (setq at-start nil) 522 (setq at-start nil)
523 (cond 523 (cond
524 ((looking-at "^added") 524 ((looking-at "^added")
525 (setq current-vc-state 'edited) 525 (setq current-vc-state 'added)
526 (setq current-bzr-state 'added)) 526 (setq current-bzr-state 'added))
527 ((looking-at "^kind changed") 527 ((looking-at "^kind changed")
528 (setq current-vc-state 'edited) 528 (setq current-vc-state 'edited)
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index c3aff66588b..321f4e52805 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -947,6 +947,7 @@ is non-nil."
947 (cond 947 (cond
948 ;; entry for a "locally added" file (not yet committed) 948 ;; entry for a "locally added" file (not yet committed)
949 ((looking-at "/[^/]+/0/") 949 ((looking-at "/[^/]+/0/")
950 (vc-file-setprop file 'vc-backend 'CVS)
950 (vc-file-setprop file 'vc-checkout-time 0) 951 (vc-file-setprop file 'vc-checkout-time 0)
951 (vc-file-setprop file 'vc-working-revision "0") 952 (vc-file-setprop file 'vc-working-revision "0")
952 (if set-state (vc-file-setprop file 'vc-state 'edited))) 953 (if set-state (vc-file-setprop file 'vc-state 'edited)))
@@ -962,6 +963,7 @@ is non-nil."
962 ;; sticky tag 963 ;; sticky tag
963 "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) 964 "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty)
964 "\\(.*\\)")) ;Sticky tag 965 "\\(.*\\)")) ;Sticky tag
966 (vc-file-setprop file 'vc-backend 'CVS)
965 (vc-file-setprop file 'vc-working-revision (match-string 1)) 967 (vc-file-setprop file 'vc-working-revision (match-string 1))
966 (vc-file-setprop file 'vc-cvs-sticky-tag 968 (vc-file-setprop file 'vc-cvs-sticky-tag
967 (vc-cvs-parse-sticky-tag (match-string 4) 969 (vc-cvs-parse-sticky-tag (match-string 4)
diff --git a/lisp/vc-git.el b/lisp/vc-git.el
index 7895251be0e..64bcbeb0b2b 100644
--- a/lisp/vc-git.el
+++ b/lisp/vc-git.el
@@ -155,7 +155,6 @@
155 "Git-specific version of `dir-state'." 155 "Git-specific version of `dir-state'."
156 ;; FIXME: This can't set 'ignored yet 156 ;; FIXME: This can't set 'ignored yet
157 (with-temp-buffer 157 (with-temp-buffer
158 (buffer-disable-undo) ;; Because these buffers can get huge
159 (vc-git-command (current-buffer) nil nil "ls-files" "-t" "-c" "-m" "-o") 158 (vc-git-command (current-buffer) nil nil "ls-files" "-t" "-c" "-m" "-o")
160 (goto-char (point-min)) 159 (goto-char (point-min))
161 (let ((status-char nil) 160 (let ((status-char nil)
@@ -168,19 +167,24 @@
168 (line-end-position)))) 167 (line-end-position))))
169 (cond 168 (cond
170 ;; The rest of the possible states in "git ls-files -t" output: 169 ;; The rest of the possible states in "git ls-files -t" output:
171 ;; R removed/deleted
172 ;; K to be killed 170 ;; K to be killed
173 ;; should not show up in vc-dired, so don't deal with them 171 ;; should not show up in vc-dired, so don't deal with them
174 ;; here. 172 ;; here.
175 ((eq status-char ?H) 173 ((eq status-char ?H)
174 (vc-file-setprop file 'vc-backend 'Git)
176 (vc-file-setprop file 'vc-state 'up-to-date)) 175 (vc-file-setprop file 'vc-state 'up-to-date))
176 ((eq status-char ?R)
177 (vc-file-setprop file 'vc-backend 'Git)
178 (vc-file-setprop file 'vc-state 'removed))
177 ((eq status-char ?M) 179 ((eq status-char ?M)
180 (vc-file-setprop file 'vc-backend 'Git)
178 (vc-file-setprop file 'vc-state 'edited)) 181 (vc-file-setprop file 'vc-state 'edited))
179 ((eq status-char ?C) 182 ((eq status-char ?C)
183 (vc-file-setprop file 'vc-backend 'Git)
180 (vc-file-setprop file 'vc-state 'edited)) 184 (vc-file-setprop file 'vc-state 'edited))
181 ((eq status-char ??) 185 ((eq status-char ??)
182 (vc-file-setprop file 'vc-backend 'none) 186 (vc-file-setprop file 'vc-backend 'none)
183 (vc-file-setprop file 'vc-state 'nil))) 187 (vc-file-setprop file 'vc-state nil)))
184 (forward-line))))) 188 (forward-line)))))
185 189
186(defun vc-git-working-revision (file) 190(defun vc-git-working-revision (file)
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el
index 41cc883c0a4..dd8cccb724b 100644
--- a/lisp/vc-hg.el
+++ b/lisp/vc-hg.el
@@ -194,21 +194,35 @@
194 (buffer-substring-no-properties (+ (point) 2) 194 (buffer-substring-no-properties (+ (point) 2)
195 (line-end-position)))) 195 (line-end-position))))
196 (cond 196 (cond
197 ;; State flag for a clean file is now C, might change to =.
197 ;; The rest of the possible states in "hg status" output: 198 ;; The rest of the possible states in "hg status" output:
198 ;; R = removed
199 ;; ! = deleted, but still tracked 199 ;; ! = deleted, but still tracked
200 ;; should not show up in vc-dired, so don't deal with them 200 ;; should not show up in vc-dired, so don't deal with them
201 ;; here. 201 ;; here.
202 ((eq status-char ?C)
203 (vc-file-setprop file 'vc-backend 'Hg)
204 (vc-file-setprop file 'vc-state 'up-to-date))
202 ((eq status-char ?A) 205 ((eq status-char ?A)
206 (vc-file-setprop file 'vc-backend 'Hg)
203 (vc-file-setprop file 'vc-working-revision "0") 207 (vc-file-setprop file 'vc-working-revision "0")
204 (vc-file-setprop file 'vc-state 'edited)) 208 (vc-file-setprop file 'vc-state 'added))
209 ((eq status-char ?R)
210 (vc-file-setprop file 'vc-backend 'Hg)
211 (vc-file-setprop file 'vc-state 'removed))
205 ((eq status-char ?M) 212 ((eq status-char ?M)
213 (vc-file-setprop file 'vc-backend 'Hg)
206 (vc-file-setprop file 'vc-state 'edited)) 214 (vc-file-setprop file 'vc-state 'edited))
207 ((eq status-char ?I) 215 ((eq status-char ?I)
216 (vc-file-setprop file 'vc-backend 'Hg)
208 (vc-file-setprop file 'vc-state 'ignored)) 217 (vc-file-setprop file 'vc-state 'ignored))
209 ((eq status-char ??) 218 ((eq status-char ??)
210 (vc-file-setprop file 'vc-backend 'none) 219 (vc-file-setprop file 'vc-backend 'none)
211 (vc-file-setprop file 'vc-state 'unregistered))) 220 (vc-file-setprop file 'vc-state 'unregistered))
221 ((eq status-char ?!)
222 nil)
223 (t ;; Presently C, might change to = in 0.9.6
224 (vc-file-setprop file 'vc-backend 'Hg)
225 (vc-file-setprop file 'vc-state 'up-to-date)))
212 (forward-line))))) 226 (forward-line)))))
213 227
214(defun vc-hg-working-revision (file) 228(defun vc-hg-working-revision (file)
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 3d589e117c8..39550da8018 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -503,14 +503,16 @@ For registered files, the value returned is one of:
503 Often represented by vc-working-revision = \"0\" in VCSes 503 Often represented by vc-working-revision = \"0\" in VCSes
504 with monotonic IDs like Subversion and Mercurial. 504 with monotonic IDs like Subversion and Mercurial.
505 505
506 'ignored The file showed up in a dir-state listing with a flag 506 'removed Scheduled to be deleted from the repository on next commit.
507
508 'ignored The file showed up in a dir-state listing with a flag
507 indicating the version-control system is ignoring it, 509 indicating the version-control system is ignoring it,
508 Note: This property is not set reliably (some VCSes 510 Note: This property is not set reliably (some VCSes
509 don't have useful directory-status commands) so assume 511 don't have useful directory-status commands) so assume
510 that any file with vc-state nil might be ignorable 512 that any file with vc-state nil might be ignorable
511 without VC knowing it. 513 without VC knowing it.
512 514
513 'unregistered The file showed up in a dir-state listing with a flag 515 'unregistered The file showed up in a dir-state listing with a flag
514 indicating that it is not under version control. 516 indicating that it is not under version control.
515 Note: This property is not set reliably (some VCSes 517 Note: This property is not set reliably (some VCSes
516 don't have useful directory-status commands) so assume 518 don't have useful directory-status commands) so assume
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index ced4c941b55..385260b3d87 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -366,6 +366,30 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
366 (error "Couldn't analyze svn update result"))) 366 (error "Couldn't analyze svn update result")))
367 (message "Merging changes into %s...done" file)))) 367 (message "Merging changes into %s...done" file))))
368 368
369(defun vc-svn-modify-change-comment (files rev comment)
370 "Modify the change comments for a specified REV.
371You must have ssh access to the repository host, and the directory Emacs
372uses locally for temp files must also be writeable by you on that host."
373 (vc-do-command nil 0 "svn" nil "info")
374 (set-buffer "*vc*")
375 (goto-char (point-min))
376 (unless (re-search-forward "Repository Root: svn\\+ssh://\\([^/]+\\)\\(/.*\\)" nil t)
377 (error "Repository information is unavailable."))
378 (let* ((tempfile (make-temp-file user-mail-address))
379 (host (match-string 1))
380 (directory (match-string 2))
381 (remotefile (concat host ":" tempfile)))
382 (with-temp-buffer
383 (insert comment)
384 (write-region (point-min) (point-max) tempfile))
385 (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile)
386 (error "Copy of comment to %s failed" remotefile))
387 (unless (vc-do-command nil 0 "ssh" nil
388 "-q" host
389 (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
390 directory rev tempfile tempfile))
391 (error "Log edit failed"))
392 ))
369 393
370;;; 394;;;
371;;; History functions 395;;; History functions
@@ -543,15 +567,16 @@ information about FILENAME and return its status."
543 (let (file status) 567 (let (file status)
544 (goto-char (point-min)) 568 (goto-char (point-min))
545 (while (re-search-forward 569 (while (re-search-forward
546 ;; Ignore the files with status in [IX?]. 570 ;; Ignore the files with status X.
547 "^[ ACDGMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t) 571 "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
548 ;; If the username contains spaces, the output format is ambiguous, 572 ;; If the username contains spaces, the output format is ambiguous,
549 ;; so don't trust the output's filename unless we have to. 573 ;; so don't trust the output's filename unless we have to.
550 (setq file (or filename 574 (setq file (or filename
551 (expand-file-name 575 (expand-file-name
552 (buffer-substring (point) (line-end-position))))) 576 (buffer-substring (point) (line-end-position)))))
553 (setq status (char-after (line-beginning-position))) 577 (setq status (char-after (line-beginning-position)))
554 (unless (eq status ??) 578 (if (eq status ??)
579 (vc-file-setprop file 'vc-state 'unregistered)
555 ;; `vc-BACKEND-registered' must not set vc-backend, 580 ;; `vc-BACKEND-registered' must not set vc-backend,
556 ;; which is instead set in vc-registered. 581 ;; which is instead set in vc-registered.
557 (unless filename (vc-file-setprop file 'vc-backend 'SVN)) 582 (unless filename (vc-file-setprop file 'vc-backend 'SVN))
@@ -573,15 +598,15 @@ information about FILENAME and return its status."
573 ;; If the file was actually copied, (match-string 2) is "-". 598 ;; If the file was actually copied, (match-string 2) is "-".
574 (vc-file-setprop file 'vc-working-revision "0") 599 (vc-file-setprop file 'vc-working-revision "0")
575 (vc-file-setprop file 'vc-checkout-time 0) 600 (vc-file-setprop file 'vc-checkout-time 0)
576 'edited) 601 'added)
577 ((memq status '(?M ?C)) 602 ((memq status '(?M ?C))
578 (if (eq (char-after (match-beginning 1)) ?*) 603 (if (eq (char-after (match-beginning 1)) ?*)
579 'needs-merge 604 'needs-merge
580 'edited)) 605 'edited))
581 ((eq status ?I) 606 ((eq status ?I)
582 (vc-file-setprop file 'vc-state 'ignored)) 607 (vc-file-setprop file 'vc-state 'ignored))
583 ((eq status ??) 608 ((eq status ?R)
584 (vc-file-setprop file 'vc-state 'unregistered)) 609 (vc-file-setprop file 'vc-state 'removed))
585 (t 'edited))))) 610 (t 'edited)))))
586 (if filename (vc-file-getprop filename 'vc-state)))) 611 (if filename (vc-file-getprop filename 'vc-state))))
587 612
diff --git a/lisp/vc.el b/lisp/vc.el
index 5ec872523b5..ddcb53a0cb6 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -159,11 +159,13 @@
159;; 159;;
160;; - dir-state (dir) 160;; - dir-state (dir)
161;; 161;;
162;; If provided, this function is used to find the version control state 162;; If provided, this function is used to find the version control
163;; of all files in DIR, and all subdirecties of DIR, in a fast way. 163;; state of as many files as possible in DIR, and all subdirecties
164;; The function should not return anything, but rather store the files' 164;; of DIR, in a fast way; it is used to avoid expensive indivitual
165;; states into the corresponding `vc-state' properties. (Note: in 165;; vc-state calls. The function should not return anything, but
166;; older versions this method was not required to recurse into 166;; rather store the files' states into the corresponding properties.
167;; Two properties are required: `vc-backend' and `vc-state'. (Note:
168;; in older versions this method was not required to recurse into
167;; subdirectories.) 169;; subdirectories.)
168;; 170;;
169;; * working-revision (file) 171;; * working-revision (file)
@@ -1346,6 +1348,12 @@ NOT-URGENT means it is ok to continue if the user says not to save."
1346 1348
1347(defvar vc-dired-window-configuration) 1349(defvar vc-dired-window-configuration)
1348 1350
1351(defun vc-compatible-state (p q)
1352 "Controls which states can be in the same commit."
1353 (or
1354 (eq p q)
1355 (and (member p '(edited added removed)) (member q '(edited added removed)))))
1356
1349;; Here's the major entry point. 1357;; Here's the major entry point.
1350 1358
1351;;;###autoload 1359;;;###autoload
@@ -1386,7 +1394,7 @@ merge in the changes into your working copy."
1386 revision) 1394 revision)
1387 ;; Verify that the fileset is homogenous 1395 ;; Verify that the fileset is homogenous
1388 (dolist (file (cdr files)) 1396 (dolist (file (cdr files))
1389 (if (not (eq (vc-state file) state)) 1397 (if (not (vc-compatible-state (vc-state file) state))
1390 (error "Fileset is in a mixed-up state")) 1398 (error "Fileset is in a mixed-up state"))
1391 (if (not (eq (vc-checkout-model file) model)) 1399 (if (not (eq (vc-checkout-model file) model))
1392 (error "Fileset has mixed checkout models"))) 1400 (error "Fileset has mixed checkout models")))
@@ -1436,7 +1444,7 @@ merge in the changes into your working copy."
1436 ;; do nothing 1444 ;; do nothing
1437 (message "Fileset is up-to-date")))) 1445 (message "Fileset is up-to-date"))))
1438 ;; Files have local changes 1446 ;; Files have local changes
1439 ((eq state 'edited) 1447 ((vc-compatible-state state 'edited)
1440 (let ((ready-for-commit files)) 1448 (let ((ready-for-commit files))
1441 ;; If files are edited but read-only, give user a chance to correct 1449 ;; If files are edited but read-only, give user a chance to correct
1442 (dolist (file files) 1450 (dolist (file files)
@@ -2349,7 +2357,9 @@ Called by dired after any portion of a vc-dired buffer has been read in."
2349 (if (and (vc-call-backend backend 'responsible-p default-directory) 2357 (if (and (vc-call-backend backend 'responsible-p default-directory)
2350 (vc-find-backend-function backend 'dir-state)) 2358 (vc-find-backend-function backend 'dir-state))
2351 (vc-call-backend backend 'dir-state default-directory))) 2359 (vc-call-backend backend 'dir-state default-directory)))
2352 (let (filename (inhibit-read-only t)) 2360 (let (filename
2361 (inhibit-read-only t)
2362 (buffer-undo-list t))
2353 (goto-char (point-min)) 2363 (goto-char (point-min))
2354 (while (not (eobp)) 2364 (while (not (eobp))
2355 (cond 2365 (cond
@@ -2383,27 +2393,25 @@ Called by dired after any portion of a vc-dired buffer has been read in."
2383 (t 2393 (t
2384 (vc-dired-reformat-line nil) 2394 (vc-dired-reformat-line nil)
2385 (forward-line 1)))) 2395 (forward-line 1))))
2386 ;; try to head off calling the expensive state query - 2396 ;; Try to head off calling the expensive state query -
2387 ;; ignore object files, TeX intermediate files, and so forth. 2397 ;; ignore object files, TeX intermediate files, and so forth.
2388 ((vc-dired-ignorable-p filename) 2398 ((vc-dired-ignorable-p filename)
2389 (dired-kill-line)) 2399 (dired-kill-line))
2390 ;; ordinary file -- call the (possibly expensive) state query 2400 ;; Ordinary file -- call the (possibly expensive) state query
2391 (t 2401 ;;
2392 (let ((backend (vc-backend filename))) 2402 ;; First case: unregistered or unknown. (Unknown shouldn't happen here)
2393 (cond 2403 ((member (vc-state filename) '(nil unregistered))
2394 ;; Not registered 2404 (if vc-dired-terse-mode
2395 ((not backend) 2405 (dired-kill-line)
2396 (if vc-dired-terse-mode 2406 (vc-dired-reformat-line "?")
2397 (dired-kill-line) 2407 (forward-line 1)))
2398 (vc-dired-reformat-line "?") 2408 ;; Either we're in non-terse mode or it's out of date
2399 (forward-line 1))) 2409 ((not (and vc-dired-terse-mode (vc-up-to-date-p filename)))
2400 ;; Either we're in non-terse mode or it's out of date 2410 (vc-dired-reformat-line (vc-call dired-state-info filename))
2401 ((not (and vc-dired-terse-mode (vc-up-to-date-p filename))) 2411 (forward-line 1))
2402 (vc-dired-reformat-line (vc-call dired-state-info filename)) 2412 ;; Remaining cases are under version control but uninteresting
2403 (forward-line 1)) 2413 (t
2404 ;; Remaining cases are under version control but uninteresting 2414 (dired-kill-line))))
2405 (t
2406 (dired-kill-line)))))))
2407 ;; any other line 2415 ;; any other line
2408 (t (forward-line 1)))) 2416 (t (forward-line 1))))
2409 (vc-dired-purge)) 2417 (vc-dired-purge))
@@ -3076,6 +3084,7 @@ to provide the `find-revision' operation instead."
3076 ((eq state 'needs-merge) "(merge)") 3084 ((eq state 'needs-merge) "(merge)")
3077 ((eq state 'needs-patch) "(patch)") 3085 ((eq state 'needs-patch) "(patch)")
3078 ((eq state 'added) "(added)") 3086 ((eq state 'added) "(added)")
3087 ((eq state 'removed) "(removed)")
3079 ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out 3088 ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out
3080 ((eq state 'unregistered) "?") 3089 ((eq state 'unregistered) "?")
3081 ((eq state 'unlocked-changes) "(stale)") 3090 ((eq state 'unlocked-changes) "(stale)")
diff --git a/src/ChangeLog b/src/ChangeLog
index aca22996d14..b3fddb33219 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,41 @@
12007-12-31 Tom Tromey <tromey@redhat.com> (tiny change)
2
3 * dbusbind.c (xd_read_message): Use non-static input_event struct.
4
52007-12-31 Magnus Henoch <mange@freemail.hu>
6
7 * dbusbind.c (xd_signature): Signature of variant is just "v".
8
92007-12-30 Michael Albinus <michael.albinus@gmx.de>
10
11 * dbusbind.c: Fix several errors and compiler warnings. Reported
12 by Tom Tromey <tromey@redhat.com>
13 (XD_ERROR, XD_DEBUG_MESSAGE)
14 (XD_DEBUG_VALID_LISP_OBJECT_P): Wrap code with "do ... while (0)".
15 (xd_append_arg): Part for basic D-Bus types rewitten.
16 (xd_retrieve_arg): Split implementation of DBUS_TYPE_BYTE and
17 DBUS_TYPE_(U)INT16. Don't call XD_DEBUG_MESSAGE with "%f" if not
18 appropriate.
19 (xd_read_message): Return Qnil. Don't signal an error; it is not
20 useful during event reading.
21 (Fdbus_register_signal): Signal an error if the check for
22 FUNCTIONP fails.
23 (Fdbus_register_method): New function. The implementation is not
24 complete, the call of the function signals an error therefore.
25 (Fdbus_unregister_object): New function, renamed from
26 Fdbus_unregister_signal. The initial check signals an error, if
27 it the objct is not well formed.
28
292007-12-30 Richard Stallman <rms@gnu.org>
30
31 * textprop.c (get_char_property_and_overlay):
32 Signal error if POSITION is out of range in a buffer.
33
342007-12-29 Martin Rudalics <rudalics@gmx.at>
35
36 * w32fns.c (Fx_create_frame): Make copy of frame parameters
37 because the original parameters are in pure storage now.
38
12007-12-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 392007-12-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
2 40
3 * xdisp.c (phys_cursor_in_rect_p): Check if cursor is in fringe area. 41 * xdisp.c (phys_cursor_in_rect_p): Check if cursor is in fringe area.
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 88f2ccdb3eb..57625d3876e 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -35,7 +35,8 @@ Lisp_Object Qdbus_get_unique_name;
35Lisp_Object Qdbus_call_method; 35Lisp_Object Qdbus_call_method;
36Lisp_Object Qdbus_send_signal; 36Lisp_Object Qdbus_send_signal;
37Lisp_Object Qdbus_register_signal; 37Lisp_Object Qdbus_register_signal;
38Lisp_Object Qdbus_unregister_signal; 38Lisp_Object Qdbus_register_method;
39Lisp_Object Qdbus_unregister_object;
39 40
40/* D-Bus error symbol. */ 41/* D-Bus error symbol. */
41Lisp_Object Qdbus_error; 42Lisp_Object Qdbus_error;
@@ -65,7 +66,7 @@ Lisp_Object Vdbus_debug;
65 66
66/* Raise a Lisp error from a D-Bus ERROR. */ 67/* Raise a Lisp error from a D-Bus ERROR. */
67#define XD_ERROR(error) \ 68#define XD_ERROR(error) \
68 { \ 69 do { \
69 char s[1024]; \ 70 char s[1024]; \
70 strcpy (s, error.message); \ 71 strcpy (s, error.message); \
71 dbus_error_free (&error); \ 72 dbus_error_free (&error); \
@@ -73,33 +74,37 @@ Lisp_Object Vdbus_debug;
73 if (strchr (s, '\n') != NULL) \ 74 if (strchr (s, '\n') != NULL) \
74 s[strlen (s) - 1] = '\0'; \ 75 s[strlen (s) - 1] = '\0'; \
75 xsignal1 (Qdbus_error, build_string (s)); \ 76 xsignal1 (Qdbus_error, build_string (s)); \
76 } 77 } while (0)
77 78
78/* Macros for debugging. In order to enable them, build with 79/* Macros for debugging. In order to enable them, build with
79 "make MYCPPFLAGS='-DDBUS_DEBUG'". */ 80 "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */
80#ifdef DBUS_DEBUG 81#ifdef DBUS_DEBUG
81#define XD_DEBUG_MESSAGE(...) \ 82#define XD_DEBUG_MESSAGE(...) \
82 { \ 83 do { \
83 char s[1024]; \ 84 char s[1024]; \
84 sprintf (s, __VA_ARGS__); \ 85 sprintf (s, __VA_ARGS__); \
85 printf ("%s: %s\n", __func__, s); \ 86 printf ("%s: %s\n", __func__, s); \
86 message ("%s: %s", __func__, s); \ 87 message ("%s: %s", __func__, s); \
87 } 88 } while (0)
88#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \ 89#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
89 if (!valid_lisp_object_p (object)) \ 90 do { \
90 { \ 91 if (!valid_lisp_object_p (object)) \
91 XD_DEBUG_MESSAGE ("%s Assertion failure", __LINE__); \ 92 { \
92 xsignal1 (Qdbus_error, build_string ("Assertion failure")); \ 93 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
93 } 94 xsignal1 (Qdbus_error, build_string ("Assertion failure")); \
95 } \
96 } while (0)
94 97
95#else /* !DBUS_DEBUG */ 98#else /* !DBUS_DEBUG */
96#define XD_DEBUG_MESSAGE(...) \ 99#define XD_DEBUG_MESSAGE(...) \
97 if (!NILP (Vdbus_debug)) \ 100 do { \
98 { \ 101 if (!NILP (Vdbus_debug)) \
99 char s[1024]; \ 102 { \
100 sprintf (s, __VA_ARGS__); \ 103 char s[1024]; \
101 message ("%s: %s", __func__, s); \ 104 sprintf (s, __VA_ARGS__); \
102 } 105 message ("%s: %s", __func__, s); \
106 } \
107 } while (0)
103#define XD_DEBUG_VALID_LISP_OBJECT_P(object) 108#define XD_DEBUG_VALID_LISP_OBJECT_P(object)
104#endif 109#endif
105 110
@@ -250,7 +255,7 @@ xd_signature(signature, dtype, parent_type, object)
250 wrong_type_argument (intern ("D-Bus"), 255 wrong_type_argument (intern ("D-Bus"),
251 XCAR (XCDR (XD_NEXT_VALUE (elt)))); 256 XCAR (XCDR (XD_NEXT_VALUE (elt))));
252 257
253 sprintf (signature, "%c%s", dtype, x); 258 sprintf (signature, "%c", dtype);
254 break; 259 break;
255 260
256 case DBUS_TYPE_STRUCT: 261 case DBUS_TYPE_STRUCT:
@@ -328,75 +333,112 @@ xd_append_arg (dtype, object, iter)
328 Lisp_Object object; 333 Lisp_Object object;
329 DBusMessageIter *iter; 334 DBusMessageIter *iter;
330{ 335{
331 Lisp_Object elt;
332 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; 336 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
333 DBusMessageIter subiter; 337 DBusMessageIter subiter;
334 char *value;
335
336 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", object, Qnil)));
337 338
338 if (XD_BASIC_DBUS_TYPE (dtype)) 339 if (XD_BASIC_DBUS_TYPE (dtype))
339 { 340 switch (dtype)
340 switch (dtype) 341 {
342 case DBUS_TYPE_BYTE:
341 { 343 {
342 case DBUS_TYPE_BYTE: 344 unsigned int val = XUINT (object) & 0xFF;
343 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); 345 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
344 value = (unsigned char *) XUINT (object); 346 if (!dbus_message_iter_append_basic (iter, dtype, &val))
345 break; 347 xsignal2 (Qdbus_error,
346 348 build_string ("Unable to append argument"), object);
347 case DBUS_TYPE_BOOLEAN: 349 return;
348 XD_DEBUG_MESSAGE ("%c %s", dtype, (NILP (object)) ? "false" : "true"); 350 }
349 value = (NILP (object))
350 ? (unsigned char *) FALSE : (unsigned char *) TRUE;
351 break;
352
353 case DBUS_TYPE_INT16:
354 XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
355 value = (char *) (dbus_int16_t *) XINT (object);
356 break;
357 351
358 case DBUS_TYPE_UINT16: 352 case DBUS_TYPE_BOOLEAN:
359 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); 353 {
360 value = (char *) (dbus_uint16_t *) XUINT (object); 354 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
361 break; 355 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
356 if (!dbus_message_iter_append_basic (iter, dtype, &val))
357 xsignal2 (Qdbus_error,
358 build_string ("Unable to append argument"), object);
359 return;
360 }
362 361
363 case DBUS_TYPE_INT32: 362 case DBUS_TYPE_INT16:
364 XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); 363 {
365 value = (char *) (dbus_int32_t *) XINT (object); 364 dbus_int16_t val = XINT (object);
366 break; 365 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
366 if (!dbus_message_iter_append_basic (iter, dtype, &val))
367 xsignal2 (Qdbus_error,
368 build_string ("Unable to append argument"), object);
369 return;
370 }
367 371
368 case DBUS_TYPE_UINT32: 372 case DBUS_TYPE_UINT16:
369 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); 373 {
370 value = (char *) (dbus_uint32_t *) XUINT (object); 374 dbus_uint16_t val = XUINT (object);
371 break; 375 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
376 if (!dbus_message_iter_append_basic (iter, dtype, &val))
377 xsignal2 (Qdbus_error,
378 build_string ("Unable to append argument"), object);
379 return;
380 }
372 381
373 case DBUS_TYPE_INT64: 382 case DBUS_TYPE_INT32:
374 XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object)); 383 {
375 value = (char *) (dbus_int64_t *) XINT (object); 384 dbus_int32_t val = XINT (object);
376 break; 385 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
386 if (!dbus_message_iter_append_basic (iter, dtype, &val))
387 xsignal2 (Qdbus_error,
388 build_string ("Unable to append argument"), object);
389 return;
390 }
377 391
378 case DBUS_TYPE_UINT64: 392 case DBUS_TYPE_UINT32:
379 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object)); 393 {
380 value = (char *) (dbus_int64_t *) XUINT (object); 394 dbus_uint32_t val = XUINT (object);
381 break; 395 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
396 if (!dbus_message_iter_append_basic (iter, dtype, &val))
397 xsignal2 (Qdbus_error,
398 build_string ("Unable to append argument"), object);
399 return;
400 }
382 401
383 case DBUS_TYPE_DOUBLE: 402 case DBUS_TYPE_INT64:
384 XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT (object)); 403 {
385 value = (char *) (float *) XFLOAT (object); 404 dbus_int64_t val = XINT (object);
386 break; 405 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
406 if (!dbus_message_iter_append_basic (iter, dtype, &val))
407 xsignal2 (Qdbus_error,
408 build_string ("Unable to append argument"), object);
409 return;
410 }
387 411
388 case DBUS_TYPE_STRING: 412 case DBUS_TYPE_UINT64:
389 case DBUS_TYPE_OBJECT_PATH: 413 {
390 case DBUS_TYPE_SIGNATURE: 414 dbus_uint64_t val = XUINT (object);
391 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (object)); 415 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
392 value = SDATA (object); 416 if (!dbus_message_iter_append_basic (iter, dtype, &val))
393 break; 417 xsignal2 (Qdbus_error,
418 build_string ("Unable to append argument"), object);
419 return;
394 } 420 }
395 421
396 if (!dbus_message_iter_append_basic (iter, dtype, &value)) 422 case DBUS_TYPE_DOUBLE:
397 xsignal2 (Qdbus_error, 423 XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT_DATA (object));
398 build_string ("Unable to append argument"), object); 424 if (!dbus_message_iter_append_basic (iter, dtype,
399 } 425 &XFLOAT_DATA (object)))
426 xsignal2 (Qdbus_error,
427 build_string ("Unable to append argument"), object);
428 return;
429
430 case DBUS_TYPE_STRING:
431 case DBUS_TYPE_OBJECT_PATH:
432 case DBUS_TYPE_SIGNATURE:
433 {
434 char *val = SDATA (object);
435 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
436 if (!dbus_message_iter_append_basic (iter, dtype, &val))
437 xsignal2 (Qdbus_error,
438 build_string ("Unable to append argument"), object);
439 return;
440 }
441 }
400 442
401 else /* Compound types. */ 443 else /* Compound types. */
402 { 444 {
@@ -470,11 +512,10 @@ xd_retrieve_arg (dtype, iter)
470 switch (dtype) 512 switch (dtype)
471 { 513 {
472 case DBUS_TYPE_BYTE: 514 case DBUS_TYPE_BYTE:
473 case DBUS_TYPE_INT16:
474 case DBUS_TYPE_UINT16:
475 { 515 {
476 dbus_uint16_t val; 516 unsigned int val;
477 dbus_message_iter_get_basic (iter, &val); 517 dbus_message_iter_get_basic (iter, &val);
518 val = val & 0xFF;
478 XD_DEBUG_MESSAGE ("%c %d", dtype, val); 519 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
479 return make_number (val); 520 return make_number (val);
480 } 521 }
@@ -487,15 +528,21 @@ xd_retrieve_arg (dtype, iter)
487 return (val == FALSE) ? Qnil : Qt; 528 return (val == FALSE) ? Qnil : Qt;
488 } 529 }
489 530
531 case DBUS_TYPE_INT16:
532 case DBUS_TYPE_UINT16:
533 {
534 dbus_uint16_t val;
535 dbus_message_iter_get_basic (iter, &val);
536 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
537 return make_number (val);
538 }
539
490 case DBUS_TYPE_INT32: 540 case DBUS_TYPE_INT32:
491 case DBUS_TYPE_UINT32: 541 case DBUS_TYPE_UINT32:
492 { 542 {
493 dbus_uint32_t val; 543 dbus_uint32_t val;
494 dbus_message_iter_get_basic (iter, &val); 544 dbus_message_iter_get_basic (iter, &val);
495 if (FIXNUM_OVERFLOW_P (val)) 545 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
496 XD_DEBUG_MESSAGE ("%c %f", dtype, val)
497 else
498 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
499 return make_fixnum_or_float (val); 546 return make_fixnum_or_float (val);
500 } 547 }
501 548
@@ -504,10 +551,7 @@ xd_retrieve_arg (dtype, iter)
504 { 551 {
505 dbus_uint64_t val; 552 dbus_uint64_t val;
506 dbus_message_iter_get_basic (iter, &val); 553 dbus_message_iter_get_basic (iter, &val);
507 if (FIXNUM_OVERFLOW_P (val)) 554 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
508 XD_DEBUG_MESSAGE ("%c %f", dtype, val)
509 else
510 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
511 return make_fixnum_or_float (val); 555 return make_fixnum_or_float (val);
512 } 556 }
513 557
@@ -918,11 +962,12 @@ xd_read_message (bus)
918{ 962{
919 Lisp_Object args, key, value; 963 Lisp_Object args, key, value;
920 struct gcpro gcpro1; 964 struct gcpro gcpro1;
921 static struct input_event event; 965 struct input_event event;
922 DBusConnection *connection; 966 DBusConnection *connection;
923 DBusMessage *dmessage; 967 DBusMessage *dmessage;
924 DBusMessageIter iter; 968 DBusMessageIter iter;
925 unsigned int dtype; 969 unsigned int dtype;
970 int mtype;
926 char uname[DBUS_MAXIMUM_NAME_LENGTH]; 971 char uname[DBUS_MAXIMUM_NAME_LENGTH];
927 char path[DBUS_MAXIMUM_MATCH_RULE_LENGTH]; /* Unlimited in D-Bus spec. */ 972 char path[DBUS_MAXIMUM_MATCH_RULE_LENGTH]; /* Unlimited in D-Bus spec. */
928 char interface[DBUS_MAXIMUM_NAME_LENGTH]; 973 char interface[DBUS_MAXIMUM_NAME_LENGTH];
@@ -937,38 +982,37 @@ xd_read_message (bus)
937 982
938 /* Return if there is no queued message. */ 983 /* Return if there is no queued message. */
939 if (dmessage == NULL) 984 if (dmessage == NULL)
940 return; 985 return Qnil;
941
942 XD_DEBUG_MESSAGE ("Event received");
943 986
944 /* Collect the parameters. */ 987 /* Collect the parameters. */
945 args = Qnil; 988 args = Qnil;
946 GCPRO1 (args); 989 GCPRO1 (args);
947 990
948 if (!dbus_message_iter_init (dmessage, &iter))
949 {
950 UNGCPRO;
951 XD_DEBUG_MESSAGE ("Cannot read event");
952 return;
953 }
954
955 /* Loop over the resulting parameters. Construct a list. */ 991 /* Loop over the resulting parameters. Construct a list. */
956 while ((dtype = dbus_message_iter_get_arg_type (&iter)) != DBUS_TYPE_INVALID) 992 if (dbus_message_iter_init (dmessage, &iter))
957 { 993 {
958 args = Fcons (xd_retrieve_arg (dtype, &iter), args); 994 while ((dtype = dbus_message_iter_get_arg_type (&iter))
959 dbus_message_iter_next (&iter); 995 != DBUS_TYPE_INVALID)
996 {
997 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
998 dbus_message_iter_next (&iter);
999 }
1000 /* The arguments are stored in reverse order. Reorder them. */
1001 args = Fnreverse (args);
960 } 1002 }
961 1003
962 /* The arguments are stored in reverse order. Reorder them. */ 1004 /* Read message type, unique name, object path, interface and member
963 args = Fnreverse (args); 1005 from the message. */
964 1006 mtype = dbus_message_get_type (dmessage);
965 /* Read unique name, object path, interface and member from the
966 message. */
967 strcpy (uname, dbus_message_get_sender (dmessage)); 1007 strcpy (uname, dbus_message_get_sender (dmessage));
968 strcpy (path, dbus_message_get_path (dmessage)); 1008 strcpy (path, dbus_message_get_path (dmessage));
969 strcpy (interface, dbus_message_get_interface (dmessage)); 1009 strcpy (interface, dbus_message_get_interface (dmessage));
970 strcpy (member, dbus_message_get_member (dmessage)); 1010 strcpy (member, dbus_message_get_member (dmessage));
971 1011
1012 XD_DEBUG_MESSAGE ("Event received: %d %s %s %s %s %s",
1013 mtype, uname, path, interface, member,
1014 SDATA (format2 ("%s", args, Qnil)));
1015
972 /* Search for a registered function of the message. */ 1016 /* Search for a registered function of the message. */
973 key = list3 (bus, build_string (interface), build_string (member)); 1017 key = list3 (bus, build_string (interface), build_string (member));
974 value = Fgethash (key, Vdbus_registered_functions_table, Qnil); 1018 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
@@ -1013,7 +1057,7 @@ xd_read_message (bus)
1013 1057
1014 /* Cleanup. */ 1058 /* Cleanup. */
1015 dbus_message_unref (dmessage); 1059 dbus_message_unref (dmessage);
1016 UNGCPRO; 1060 RETURN_UNGCPRO (Qnil);
1017} 1061}
1018 1062
1019/* Read queued incoming messages from the system and session buses. */ 1063/* Read queued incoming messages from the system and session buses. */
@@ -1064,11 +1108,11 @@ SIGNAL and HANDLER must not be nil. Example:
1064 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler)) 1108 ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1065 1109
1066`dbus-register-signal' returns an object, which can be used in 1110`dbus-register-signal' returns an object, which can be used in
1067`dbus-unregister-signal' for removing the registration. */) 1111`dbus-unregister-object' for removing the registration. */)
1068 (bus, service, path, interface, signal, handler) 1112 (bus, service, path, interface, signal, handler)
1069 Lisp_Object bus, service, path, interface, signal, handler; 1113 Lisp_Object bus, service, path, interface, signal, handler;
1070{ 1114{
1071 Lisp_Object uname, key, value; 1115 Lisp_Object uname, key, key1, value;
1072 DBusConnection *connection; 1116 DBusConnection *connection;
1073 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH]; 1117 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1074 DBusError derror; 1118 DBusError derror;
@@ -1079,7 +1123,8 @@ SIGNAL and HANDLER must not be nil. Example:
1079 if (!NILP (path)) CHECK_STRING (path); 1123 if (!NILP (path)) CHECK_STRING (path);
1080 CHECK_STRING (interface); 1124 CHECK_STRING (interface);
1081 CHECK_STRING (signal); 1125 CHECK_STRING (signal);
1082 FUNCTIONP (handler); 1126 if (!FUNCTIONP (handler))
1127 wrong_type_argument (intern ("functionp"), handler);
1083 1128
1084 /* Retrieve unique name of service. If service is a known name, we 1129 /* Retrieve unique name of service. If service is a known name, we
1085 will register for the corresponding unique name, if any. Signals 1130 will register for the corresponding unique name, if any. Signals
@@ -1130,21 +1175,84 @@ SIGNAL and HANDLER must not be nil. Example:
1130 1175
1131 /* Create a hash table entry. */ 1176 /* Create a hash table entry. */
1132 key = list3 (bus, interface, signal); 1177 key = list3 (bus, interface, signal);
1178 key1 = list4 (uname, service, path, handler);
1179 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1180
1181 if (NILP (Fmember (key1, value)))
1182 Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1183
1184 /* Return object. */
1185 return list2 (key, list3 (service, path, handler));
1186}
1187
1188DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
1189 6, 6, 0,
1190 doc: /* Register for method METHOD on the D-Bus BUS.
1191
1192BUS is either the symbol `:system' or the symbol `:session'.
1193
1194SERVICE is the D-Bus service name of the D-Bus object METHOD is
1195registered for. It must be a known name.
1196
1197PATH is the D-Bus object path SERVICE is registered. INTERFACE is the
1198interface offered by SERVICE. It must provide METHOD. HANDLER is a
1199Lisp function to be called when a method call is received. It must
1200accept the input arguments of METHOD. The return value of HANDLER is
1201used for composing the returning D-Bus message.
1202
1203The function is not fully implemented and documented. Don't use it. */)
1204 (bus, service, path, interface, method, handler)
1205 Lisp_Object bus, service, path, interface, method, handler;
1206{
1207 Lisp_Object key, key1, value;
1208 DBusConnection *connection;
1209 int result;
1210 DBusError derror;
1211
1212 if (NILP (Vdbus_debug))
1213 xsignal1 (Qdbus_error, build_string ("Not implemented yet"));
1214
1215 /* Check parameters. */
1216 CHECK_SYMBOL (bus);
1217 CHECK_STRING (service);
1218 CHECK_STRING (path);
1219 CHECK_STRING (interface);
1220 CHECK_STRING (method);
1221 if (!FUNCTIONP (handler))
1222 wrong_type_argument (intern ("functionp"), handler);
1223 /* TODO: We must check for a valid service name, otherwise there is
1224 a segmentation fault. */
1225
1226 /* Open a connection to the bus. */
1227 connection = xd_initialize (bus);
1228
1229 /* Request the known name from the bus. We can ignore the result,
1230 it is set to -1 if there is an error - kind of redundancy. */
1231 dbus_error_init (&derror);
1232 result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
1233 if (dbus_error_is_set (&derror))
1234 XD_ERROR (derror);
1235
1236 /* Create a hash table entry. */
1237 key = list3 (bus, interface, method);
1238 key1 = list4 (Qnil, service, path, handler);
1133 value = Fgethash (key, Vdbus_registered_functions_table, Qnil); 1239 value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1134 1240
1135 if (NILP (Fmember (list4 (uname, service, path, handler), value))) 1241 /* We use nil for the unique name, because the method might be
1136 Fputhash (key, 1242 called from everybody. */
1137 Fcons (list4 (uname, service, path, handler), value), 1243 if (NILP (Fmember (key1, value)))
1138 Vdbus_registered_functions_table); 1244 Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1139 1245
1140 /* Return object. */ 1246 /* Return object. */
1141 return list2 (key, list3 (service, path, handler)); 1247 return list2 (key, list3 (service, path, handler));
1142} 1248}
1143 1249
1144DEFUN ("dbus-unregister-signal", Fdbus_unregister_signal, Sdbus_unregister_signal, 1250DEFUN ("dbus-unregister-object", Fdbus_unregister_object, Sdbus_unregister_object,
1145 1, 1, 0, 1251 1, 1, 0,
1146 doc: /* Unregister OBJECT from the D-Bus. 1252 doc: /* Unregister OBJECT from the D-Bus.
1147OBJECT must be the result of a preceding `dbus-register-signal' call. */) 1253OBJECT must be the result of a preceding `dbus-register-signal' or
1254`dbus-register-method' call. It returns t if OBJECT has been
1255unregistered, nil otherwise. */)
1148 (object) 1256 (object)
1149 Lisp_Object object; 1257 Lisp_Object object;
1150{ 1258{
@@ -1152,7 +1260,8 @@ OBJECT must be the result of a preceding `dbus-register-signal' call. */)
1152 struct gcpro gcpro1; 1260 struct gcpro gcpro1;
1153 1261
1154 /* Check parameter. */ 1262 /* Check parameter. */
1155 CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object)); 1263 if (!(CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object))))
1264 wrong_type_argument (intern ("D-Bus"), object);
1156 1265
1157 /* Find the corresponding entry in the hash table. */ 1266 /* Find the corresponding entry in the hash table. */
1158 value = Fgethash (XCAR (object), Vdbus_registered_functions_table, Qnil); 1267 value = Fgethash (XCAR (object), Vdbus_registered_functions_table, Qnil);
@@ -1205,9 +1314,13 @@ syms_of_dbusbind ()
1205 staticpro (&Qdbus_register_signal); 1314 staticpro (&Qdbus_register_signal);
1206 defsubr (&Sdbus_register_signal); 1315 defsubr (&Sdbus_register_signal);
1207 1316
1208 Qdbus_unregister_signal = intern ("dbus-unregister-signal"); 1317 Qdbus_register_method = intern ("dbus-register-method");
1209 staticpro (&Qdbus_unregister_signal); 1318 staticpro (&Qdbus_register_method);
1210 defsubr (&Sdbus_unregister_signal); 1319 defsubr (&Sdbus_register_method);
1320
1321 Qdbus_unregister_object = intern ("dbus-unregister-object");
1322 staticpro (&Qdbus_unregister_object);
1323 defsubr (&Sdbus_unregister_object);
1211 1324
1212 Qdbus_error = intern ("dbus-error"); 1325 Qdbus_error = intern ("dbus-error");
1213 staticpro (&Qdbus_error); 1326 staticpro (&Qdbus_error);
diff --git a/src/textprop.c b/src/textprop.c
index f7b50755ed1..6c1470735bd 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -646,6 +646,10 @@ get_char_property_and_overlay (position, prop, object, overlay)
646 Lisp_Object *overlay_vec; 646 Lisp_Object *overlay_vec;
647 struct buffer *obuf = current_buffer; 647 struct buffer *obuf = current_buffer;
648 648
649 if (XINT (position) < BUF_BEGV (XBUFFER (object))
650 || XINT (position) > BUF_ZV (XBUFFER (object)))
651 xsignal1 (Qargs_out_of_range, position);
652
649 set_buffer_temp (XBUFFER (object)); 653 set_buffer_temp (XBUFFER (object));
650 654
651 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0); 655 GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
diff --git a/src/w32fns.c b/src/w32fns.c
index 8b2b865c6d3..74629225cbf 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -4269,6 +4269,10 @@ This function is an internal primitive--use `make-frame' instead. */)
4269 4269
4270 check_w32 (); 4270 check_w32 ();
4271 4271
4272 /* Make copy of frame parameters because the original is in pure
4273 storage now. */
4274 parameters = Fcopy_alist (parameters);
4275
4272 /* Use this general default value to start with 4276 /* Use this general default value to start with
4273 until we know if this frame has a specified name. */ 4277 until we know if this frame has a specified name. */
4274 Vx_resource_name = Vinvocation_name; 4278 Vx_resource_name = Vinvocation_name;