diff options
| author | Miles Bader <[email protected]> | 2008-01-02 04:13:39 +0000 |
|---|---|---|
| committer | Miles Bader <[email protected]> | 2008-01-02 04:13:39 +0000 |
| commit | 43a8b8ca5797923a7a9848a513ecc8cfff655e17 (patch) | |
| tree | 1fcd51822e01c6017347954e46b788faa2bf728f /lisp | |
| parent | e97d3ec0184763b2479224486e70d23f03bd340f (diff) | |
| parent | aacde24f5cdebc6d7ccb2f50a9d8e413906c4497 (diff) | |
Merge from emacs--devo--0
Revision: [email protected]/emacs--unicode--0--patch-308
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 153 | ||||
| -rw-r--r-- | lisp/calc/calc-lang.el | 2 | ||||
| -rw-r--r-- | lisp/calc/calc-menu.el | 358 | ||||
| -rw-r--r-- | lisp/calc/calc-units.el | 11 | ||||
| -rw-r--r-- | lisp/cus-edit.el | 60 | ||||
| -rw-r--r-- | lisp/cus-face.el | 5 | ||||
| -rw-r--r-- | lisp/custom.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/elp.el | 50 | ||||
| -rw-r--r-- | lisp/facemenu.el | 4 | ||||
| -rw-r--r-- | lisp/faces.el | 140 | ||||
| -rw-r--r-- | lisp/files.el | 8 | ||||
| -rw-r--r-- | lisp/font-lock.el | 12 | ||||
| -rw-r--r-- | lisp/man.el | 103 | ||||
| -rw-r--r-- | lisp/net/dbus.el | 63 | ||||
| -rw-r--r-- | lisp/net/rcirc.el | 53 | ||||
| -rw-r--r-- | lisp/startup.el | 27 | ||||
| -rw-r--r-- | lisp/textmodes/ispell.el | 9 | ||||
| -rw-r--r-- | lisp/thumbs.el | 4 | ||||
| -rw-r--r-- | lisp/vc-bzr.el | 2 | ||||
| -rw-r--r-- | lisp/vc-cvs.el | 2 | ||||
| -rw-r--r-- | lisp/vc-git.el | 10 | ||||
| -rw-r--r-- | lisp/vc-hg.el | 20 | ||||
| -rw-r--r-- | lisp/vc-hooks.el | 6 | ||||
| -rw-r--r-- | lisp/vc-svn.el | 37 | ||||
| -rw-r--r-- | lisp/vc.el | 61 |
25 files changed, 888 insertions, 316 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7c3655b304..f3b62b87e1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,152 @@ +2008-01-02 Miles Bader <Miles Bader <[email protected]>> + + * net/rcirc.el (rcirc-log-filename-function): New variable. + (rcirc-log): Use `rcirc-log-filename-function' to generate the + log-file name. Don't log anything if it returns nil. + (rcirc-log-write): Use `expand-file-name' when merging the + log-file name from the alist with rcirc-log-directory; this does + the right thing if the name in the alist already an absolute + filename. Make the log-file directory if necessary. + +2007-12-29 Richard Stallman <[email protected]> + + * font-lock.el (font-lock-prepend-text-property) + (font-lock-append-text-property): Canonicalize the face and + font-lock-face properties. + + * faces.el (facep): Doc fix. + + * startup.el (fancy-startup-tail, fancy-about-text) + (fancy-startup-text): Regularize format of face property. + + * facemenu.el (list-colors-print): Use :background and :foreground + instead of background-color and foreground-color. + +2007-12-29 Drew Adams <[email protected]> + + * cus-edit.el (custom-add-parent-links): + Fill the "Parent documentation" text. + +2007-12-29 Eli Zaretskii <[email protected]> + + * textmodes/ispell.el (ispell-grep-command): Use "grep" on + MS-Windows and MS-DOS. + (ispell-grep-options): Use "-Ei" on MS-Windows and MS-DOS. + +2008-01-02 Eric S. Raymond <[email protected]> + + * vc-svn.el (vc-svn-modify-change comment): New function. + +2008-01-01 Dan Nicolaescu <[email protected]> + + * vc-git.el (vc-git-dir-state): Set the vc-backend property. Do + not disable undo, with-temp-buffer does it by default. + +2008-01-01 Eric S. Raymond <[email protected]> + + * vc-svn.el (vc-svn-parse-status): Set the 'unregisted property + correctly. + + * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call + with vc-state. + (vc-next-action): Fix vc-transfer-file call. + +2007-12-31 Tom Tromey <[email protected]> + + * emacs-lisp/elp.el (elp-results): Use header-line-format for + header. Move point to the start of the buffer. + +2007-12-31 Dan Nicolaescu <[email protected]> + + * vc-cvs.el (vc-cvs-parse-entry): Set the vc-backend property. + + * vc.el: State that dir-state is required to set the vc-state and + vc-backend properties. + +2007-12-31 Martin Rudalics <[email protected]> + + * man.el (Man-default-man-entry): Make this a defun. Improve + guessing mechanism and handling of section numbers. + +2007-12-31 Richard Stallman <[email protected]> + + * faces.el (face-all-attributes): If FRAME is nil, return defaults. + +2007-12-31 Jay Belanger <[email protected]> + + * calc/calc-units.el (calc-convert-temperature): Ensure that units + are on the result even when the result is zero. + +2007-12-30 Michael Albinus <[email protected]> + + * net/dbus.el (dbus-name-owner-changed-handler): Make the function + resistent towards wrong parameters. + (dbus-handle-event): Propagate D-Bus errors only in the debug case. + +2007-12-30 Richard Stallman <[email protected]> + + * faces.el (face-all-attributes): New function. + + * faces.el (face-differs-from-default-p): Compute list of attr names + from face-attribute-name-alist. + + * cus-edit.el (custom-face-set): Call `face-spec-set' with FOR-DEFFACE. + (custom-face-save): Likewise. + (custom-face-reset-saved, custom-face-reset-standard): Likewise. + + * cus-face.el (custom-declare-face): Per frame, use `face-spec-set-2'. + (custom-theme-set-faces): Clear `face-override-spec' property. + Call `face-spec-set' with FOR-DEFFACE. + + * custom.el (custom-theme-recalc-face): + Simply call `face-spec-recalc'. + + * faces.el (face-spec-set): Third arg is now FOR-DEFFACE. + Use of frame as third arg is deprecated. + Handle `face-override-spec' property. + (face-spec-recalc): New function. + (face-spec-set-2): New function. + (frame-set-background-mode): Handle `face-override-spec' property. + Use `face-spec-recalc'. + (face-set-after-frame-default): Use `face-spec-recalc'. + +2007-12-29 Nick Roberts <[email protected]> + + * thumbs.el (thumbs-conversion-program): Add comment for Windows XP. + +2007-12-29 Dan Nicolaescu <[email protected]> + + * vc-hg.el (vc-hg-dir-state): Set the vc-backend property. + +2007-12-29 Eric S. Raymond <[email protected]> + + * vc-svn.el (vc-svn-parse-status): Recognize 'unregistered, + 'added, 'removed. + + * vc.el (header coment): Better description of dir-state. + (vc-compatible-state): New function. Checks whether two states + can be in the same changeset; used with 'edited it can test whether + the next action for a state should be commit. + (vc-default-dired-format0info): Display 'added state. + (vc-dired-hook): Turn off undo, this is a speed tweak. + + * vc-bzr.el (vc-bzr-dir-state): Recognize 'added. + + * vc-hg.el (vc-bzr-hg-state): Recognize 'added and 'removed. + Cope with the possibility that the 'C' status flag might change + in 0.9,6. + + * vc-git.el (vc-bzr-dir-state): Recognize 'removed. + +2007-12-29 Thien-Thi Nguyen <[email protected]> + + * files.el (cd-absolute): Fix omission bug: + Make `list-buffers-directory' buffer-local. + +2007-12-29 Dan Nicolaescu <[email protected]> + + * vc-hg.el (vc-hg-dir-state): Deal with the up-to-date state. + 2007-12-29 Jay Belanger <[email protected]> * calc/calc-aent.el (math-read-token): Fix misplaced @@ -29,6 +178,10 @@ * calc/calc-help.el (calc-d-prefix-help): Add new languages. * calc/calc-menu.el (calc-modes-menu): Add new languages. + (calc-arithmetic-menu, calc-scientific-function-menu) + (calc-algebra-menu, calc-graphics-menu, calc-vectors-menu) + (calc-units-menu, calc-variables-menu, calc-stack-menu): + Add :active keywords. 2007-12-28 Dan Nicolaescu <[email protected]> diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 3c7a22b5ff..1fff29ccb8 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1759,6 +1759,8 @@ order to Calc's." '(( infinity . var-inf) ( infinity . var-uinf))) +(put 'giac 'math-complex-format 'i) + (add-to-list 'calc-lang-allow-underscores 'giac) (put 'giac 'math-compose-subscr diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index dd9ec9a254..ca67b65abf 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -26,46 +26,58 @@ (defvar calc-arithmetic-menu (list "Arithmetic" (list "Basic" - ["-(1:)" calc-change-sign :keys "n"] - ["(2:) + (1:)" calc-plus :keys "+"] - ["(2:) - (1:)" calc-minus :keys "-"] - ["(2:) * (1:)" calc-times :keys "*"] - ["(2:) / (1:)" calc-divide :keys "/"] - ["(2:) ^ (1:)" calc-power :keys "^"] + ["-(1:)" calc-change-sign + :keys "n" :active (>= (calc-stack-size) 1)] + ["(2:) + (1:)" calc-plus + :keys "+" :active (>= (calc-stack-size) 2)] + ["(2:) - (1:)" calc-minus + :keys "-" :active (>= (calc-stack-size) 2)] + ["(2:) * (1:)" calc-times + :keys "*" :active (>= (calc-stack-size) 2)] + ["(2:) / (1:)" calc-divide + :keys "/" :active (>= (calc-stack-size) 2)] + ["(2:) ^ (1:)" calc-power + :keys "^" :active (>= (calc-stack-size) 2)] ["(2:) ^ (1/(1:))" (progn (require 'calc-ext) (let ((calc-inverse-flag t)) (call-interactively 'calc-power))) :keys "I ^" + :active (>= (calc-stack-size) 2) :help "The (1:)th root of (2:)"] ["abs(1:)" (progn (require 'calc-arith) (call-interactively 'calc-abs)) :keys "A" + :active (>= (calc-stack-size) 1) :help "Absolute value"] ["1/(1:)" (progn (require 'calc-arith) (call-interactively 'calc-inv)) - :keys "&"] + :keys "&" + :active (>= (calc-stack-size) 1)] ["sqrt(1:)" (progn (require 'calc-math) (call-interactively 'calc-sqrt)) - :keys "Q"] + :keys "Q" + :active (>= (calc-stack-size) 1)] ["idiv(2:,1:)" (progn (require 'calc-arith) (call-interactively 'calc-idiv)) :keys "\\" + :active (>= (calc-stack-size) 2) :help "The integer quotient of (2:) over (1:)"] ["(2:) mod (1:)" (progn (require 'calc-misc) (call-interactively 'calc-mod)) :keys "%" + :active (>= (calc-stack-size) 2) :help "The remainder when (2:) is divided by (1:)"]) (list "Rounding" ["floor(1:)" @@ -73,64 +85,75 @@ (require 'calc-arith) (call-interactively 'calc-floor)) :keys "F" + :active (>= (calc-stack-size) 1) :help "The greatest integer less than or equal to (1:)"] ["ceiling(1:)" (progn (require 'calc-arith) (call-interactively 'calc-ceiling)) :keys "I F" + :active (>= (calc-stack-size) 1) :help "The smallest integer greater than or equal to (1:)"] ["round(1:)" (progn (require 'calc-arith) (call-interactively 'calc-round)) :keys "R" + :active (>= (calc-stack-size) 1) :help "The nearest integer to (1:)"] ["truncate(1:)" (progn (require 'calc-arith) (call-interactively 'calc-trunc)) :keys "I R" + :active (>= (calc-stack-size) 1) :help "The integer part of (1:)"]) (list "Complex Numbers" ["Re(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-re)) - :keys "f r"] + :keys "f r" + :active (>= (calc-stack-size) 1)] ["Im(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-im)) - :keys "f i"] + :keys "f i" + :active (>= (calc-stack-size) 1)] ["conj(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-conj)) :keys "J" + :active (>= (calc-stack-size) 1) :help "The complex conjugate of (1:)"] ["length(1:)" (progn (require 'calc-arith) (call-interactively 'calc-abs)) :keys "A" + :active (>= (calc-stack-size) 1) :help "The length (absolute value) of (1:)"] ["arg(1:)" (progn (require 'calc-cplx) (call-interactively 'calc-argument)) :keys "G" + :active (>= (calc-stack-size) 1) :help "The argument (polar angle) of (1:)"]) (list "Conversion" ["Convert (1:) to a float" (progn (require 'calc-ext) (call-interactively 'calc-float)) - :keys "c f"] + :keys "c f" + :active (>= (calc-stack-size) 1)] ["Convert (1:) to a fraction" (progn (require 'calc-ext) (call-interactively 'calc-fraction)) - :keys "c F"]) + :keys "c F" + :active (>= (calc-stack-size) 1)]) (list "Binary" ["Set word size" (progn @@ -142,60 +165,70 @@ (require 'calc-bin) (call-interactively 'calc-clip)) :keys "b c" + :active (>= (calc-stack-size) 1) :help "Reduce (1:) modulo 2^wordsize"] ["(2:) and (1:)" (progn (require 'calc-bin) (call-interactively 'calc-and)) :keys "b a" + :active (>= (calc-stack-size) 2) :help "Bitwise AND [modulo 2^wordsize]"] ["(2:) or (1:)" (progn (require 'calc-bin) (call-interactively 'calc-or)) :keys "b o" + :active (>= (calc-stack-size) 2) :help "Bitwise inclusive OR [modulo 2^wordsize]"] ["(2:) xor (1:)" (progn (require 'calc-bin) (call-interactively 'calc-xor)) :keys "b x" + :active (>= (calc-stack-size) 2) :help "Bitwise exclusive OR [modulo 2^wordsize]"] ["diff(2:,1:)" (progn (require 'calc-bin) (call-interactively 'calc-diff)) :keys "b d" + :active (>= (calc-stack-size) 2) :help "Bitwise difference [modulo 2^wordsize]"] ["not (1:)" (progn (require 'calc-bin) (call-interactively 'calc-not)) :keys "b n" + :active (>= (calc-stack-size) 1) :help "Bitwise NOT [modulo 2^wordsize]"] ["left shift(1:)" (progn (require 'calc-bin) (call-interactively 'calc-lshift-binary)) :keys "b l" + :active (>= (calc-stack-size) 1) :help "Shift (1:)[modulo 2^wordsize] one bit left"] ["right shift(1:)" (progn (require 'calc-bin) (call-interactively 'calc-rshift-binary)) :keys "b r" + :active (>= (calc-stack-size) 1) :help "Shift (1:)[modulo 2^wordsize] one bit right, putting 0s on the left"] ["arithmetic right shift(1:)" (progn (require 'calc-bin) (call-interactively 'calc-rshift-arith)) :keys "b R" + :active (>= (calc-stack-size) 1) :help "Shift (1:)[modulo 2^wordsize] one bit right, duplicating the leftmost bit"] ["rotate(1:)" (progn (require 'calc-bin) (call-interactively 'calc-rotate-binary)) :keys "b t" + :active (>= (calc-stack-size) 1) :help "Rotate (1:)[modulo 2^wordsize] one bit left"]) "-------" ["Help on Arithmetic" @@ -237,69 +270,82 @@ (require 'calc-math) (call-interactively 'calc-ln)) :keys "L" + :active (>= (calc-stack-size) 1) :help "The natural logarithm"] ["e^(1:)" (progn (require 'calc-math) (call-interactively 'calc-exp)) - :keys "E"] + :keys "E" + :active (>= (calc-stack-size) 1)] ["log(1:) [base 10]" (progn (require 'calc-math) (call-interactively 'calc-log10)) :keys "H L" + :active (>= (calc-stack-size) 1) :help "The common logarithm"] ["10^(1:)" (progn (require 'calc-math) (let ((calc-inverse-flag t)) (call-interactively 'calc-log10))) - :keys "I H L"] + :keys "I H L" + :active (>= (calc-stack-size) 1)] ["log(2:) [base(1:)]" (progn (require 'calc-math) (call-interactively 'calc-log)) :keys "B" + :active (>= (calc-stack-size) 2) :help "The logarithm with an arbitrary base"] ["(2:) ^ (1:)" calc-power - :keys "^"]) + :keys "^" + :active (>= (calc-stack-size) 2)]) (list "Trigonometric Functions" ["sin(1:)" (progn (require 'calc-math) (call-interactively 'calc-sin)) - :keys "S"] + :keys "S" + :active (>= (calc-stack-size) 1)] ["cos(1:)" (progn (require 'calc-math) (call-interactively 'calc-cos)) - :keys "C"] + :keys "C" + :active (>= (calc-stack-size) 1)] ["tan(1:)" (progn (require 'calc-math) (call-interactively 'calc-tan)) - :keys "T"] + :keys "T" + :active (>= (calc-stack-size) 1)] ["arcsin(1:)" (progn (require 'calc-math) (call-interactively 'calc-arcsin)) - :keys "I S"] + :keys "I S" + :active (>= (calc-stack-size) 1)] ["arccos(1:)" (progn (require 'calc-math) (call-interactively 'calc-arccos)) - :keys "I C"] + :keys "I C" + :active (>= (calc-stack-size) 1)] ["arctan(1:)" (progn (require 'calc-math) (call-interactively 'calc-arctan)) - :keys "I T"] + :keys "I T" + :active (>= (calc-stack-size) 1)] ["arctan2(2:,1:)" (progn (require 'calc-math) (call-interactively 'calc-arctan2)) - :keys "f T"] + :keys "f T" + :active (>= (calc-stack-size) 2)] "--Angle Measure--" ["Radians" (progn @@ -327,133 +373,157 @@ (progn (require 'calc-math) (call-interactively 'calc-sinh)) - :keys "H S"] + :keys "H S" + :active (>= (calc-stack-size) 1)] ["cosh(1:)" (progn (require 'calc-math) (call-interactively 'calc-cosh)) - :keys "H C"] + :keys "H C" + :active (>= (calc-stack-size) 1)] ["tanh(1:)" (progn (require 'calc-math) (call-interactively 'calc-tanh)) - :keys "H T"] + :keys "H T" + :active (>= (calc-stack-size) 1)] ["arcsinh(1:)" (progn (require 'calc-math) (call-interactively 'calc-arcsinh)) - :keys "I H S"] + :keys "I H S" + :active (>= (calc-stack-size) 1)] ["arccosh(1:)" (progn (require 'calc-math) (call-interactively 'calc-arccosh)) - :keys "I H C"] + :keys "I H C" + :active (>= (calc-stack-size) 1)] ["arctanh(1:)" (progn (require 'calc-math) (call-interactively 'calc-arctanh)) - :keys "I H T"]) + :keys "I H T" + :active (>= (calc-stack-size) 1)]) (list "Advanced Math Functions" ["Gamma(1:)" (progn (require 'calc-comb) (call-interactively 'calc-gamma)) :keys "f g" + :active (>= (calc-stack-size) 1) :help "The Euler Gamma function"] ["GammaP(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-inc-gamma)) :keys "f G" + :active (>= (calc-stack-size) 2) :help "The lower incomplete Gamma function"] ["Beta(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-beta)) :keys "f b" + :active (>= (calc-stack-size) 2) :help "The Euler Beta function"] ["BetaI(3:,2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-inc-beta)) :keys "f B" + :active (>= (calc-stack-size) 3) :help "The incomplete Beta function"] ["erf(1:)" (progn (require 'calc-funcs) (call-interactively 'calc-erf)) :keys "f e" + :active (>= (calc-stack-size) 1) :help "The error function"] ["BesselJ(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-bessel-J)) :keys "f j" + :active (>= (calc-stack-size) 2) :help "The Bessel function of the first kind (of order (2:))"] ["BesselY(2:,1:)" (progn (require 'calc-funcs) (call-interactively 'calc-bessel-Y)) :keys "f y" + :active (>= (calc-stack-size) 2) :help "The Bessel function of the second kind (of order (2:))"]) (list "Combinatorial Functions" ["gcd(2:,1:)" (progn (require 'calc-comb) (call-interactively 'calc-gcd)) - :keys "k g"] + :keys "k g" + :active (>= (calc-stack-size) 2)] ["lcm(2:,1:)" (progn (require 'calc-comb) (call-interactively 'calc-lcm)) - :keys "k l"] + :keys "k l" + :active (>= (calc-stack-size) 2)] ["factorial(1:)" (progn (require 'calc-comb) (call-interactively 'calc-factorial)) - :keys "!"] + :keys "!" + :active (>= (calc-stack-size) 1)] ["(2:) choose (1:)" (progn (require 'calc-comb) (call-interactively 'calc-choose)) - :keys "k c"] + :keys "k c" + :active (>= (calc-stack-size) 2)] ["permutations(2:,1:)" (progn (require 'calc-comb) (call-interactively 'calc-perm)) - :keys "H k c"] + :keys "H k c" + :active (>= (calc-stack-size) 2)] ["Primality test for (1:)" (progn (require 'calc-comb) (call-interactively 'calc-prime-test)) :keys "k p" + :active (>= (calc-stack-size) 1) :help "For large (1:), a probabilistic test"] ["Factor (1:) into primes" (progn (require 'calc-comb) (call-interactively 'calc-prime-factors)) - :keys "k f"] + :keys "k f" + :active (>= (calc-stack-size) 1)] ["Next prime after (1:)" (progn (require 'calc-comb) (call-interactively 'calc-next-prime)) - :keys "k n"] + :keys "k n" + :active (>= (calc-stack-size) 1)] ["Previous prime before (1:)" (progn (require 'calc-comb) (call-interactively 'calc-prev-prime)) - :keys "I k n"] + :keys "I k n" + :active (>= (calc-stack-size) 1)] ["phi(1:)" (progn (require 'calc-comb) (call-interactively 'calc-totient)) :keys "k n" + :active (>= (calc-stack-size) 1) :help "Euler's totient function"] ["random(1:)" (progn (require 'calc-comb) (call-interactively 'calc-random)) :keys "k r" + :active (>= (calc-stack-size) 1) :help "A random number >=1 and < (1:)"]) "----" ["Help on Scientific Functions" @@ -467,12 +537,14 @@ (progn (require 'calc-alg) (call-interactively 'calc-simplify)) - :keys "a s"] + :keys "a s" + :active (>= (calc-stack-size) 1)] ["Simplify (1:) with extended rules" (progn (require 'calc-alg) (call-interactively 'calc-simplify-extended)) :keys "a e" + :active (>= (calc-stack-size) 1) :help "Apply possibly unsafe simplifications"]) (list "Manipulation" ["Expand formula (1:)" @@ -480,17 +552,20 @@ (require 'calc-alg) (call-interactively 'calc-expand-formula)) :keys "a \"" + :active (>= (calc-stack-size) 1) :help "Expand (1:) into its defining formula, if possible"] ["Evaluate variables in (1:)" (progn (require 'calc-ext) (call-interactively 'calc-evaluate)) - :keys "="] + :keys "=" + :active (>= (calc-stack-size) 1)] ["Make substitution in (1:)" (progn (require 'calc-alg) (call-interactively 'calc-substitute)) :keys "a b" + :active (>= (calc-stack-size) 1) :help "Substitute all occurrences of a sub-expression with a new sub-expression"]) (list "Polynomials" @@ -498,87 +573,102 @@ (progn (require 'calc-alg) (call-interactively 'calc-factor)) - :keys "a f"] + :keys "a f" + :active (>= (calc-stack-size) 1)] ["Collect terms in (1:)" (progn (require 'calc-alg) (call-interactively 'calc-collect)) :keys "a c" + :active (>= (calc-stack-size) 1) :help "Arrange as a polynomial in a given variable"] ["Expand (1:)" (progn (require 'calc-alg) (call-interactively 'calc-expand)) :keys "a x" + :active (>= (calc-stack-size) 1) :help "Apply distributive law everywhere"] ["Find roots of (1:)" (progn (require 'calcalg2) (call-interactively 'calc-poly-roots)) - :keys "a P"]) + :keys "a P" + :active (>= (calc-stack-size) 1)]) (list "Calculus" ["Differentiate (1:)" (progn (require 'calcalg2) (call-interactively 'calc-derivative)) - :keys "a d"] + :keys "a d" + :active (>= (calc-stack-size) 1)] ["Integrate (1:) [indefinite]" (progn (require 'calcalg2) (call-interactively 'calc-integral)) - :keys "a i"] + :keys "a i" + :active (>= (calc-stack-size) 1)] ["Integrate (1:) [definite]" (progn (require 'calcalg2) (let ((var (read-string "Integration variable: "))) (calc-tabular-command 'calcFunc-integ "Integration" "intg" nil var nil nil))) - :keys "C-u a i"] + :keys "C-u a i" + :active (>= (calc-stack-size) 1)] ["Integrate (1:) [numeric]" (progn (require 'calcalg2) (call-interactively 'calc-num-integral)) :keys "a I" + :active (>= (calc-stack-size) 1) :help "Integrate using the open Romberg method"] ["Taylor expand (1:)" (progn (require 'calcalg2) (call-interactively 'calc-taylor)) - :keys "a t"] + :keys "a t" + :active (>= (calc-stack-size) 1)] ["Minimize (2:) [initial guess = (1:)]" (progn (require 'calcalg3) (call-interactively 'calc-find-minimum)) :keys "a N" + :active (>= (calc-stack-size) 2) :help "Find a local minimum"] ["Maximize (2:) [initial guess = (1:)]" (progn (require 'calcalg3) (call-interactively 'calc-find-maximum)) :keys "a X" + :active (>= (calc-stack-size) 2) :help "Find a local maximum"]) (list "Solving" ["Solve equation (1:)" (progn (require 'calcalg2) (call-interactively 'calc-solve-for)) - :keys "a S"] + :keys "a S" + :active (>= (calc-stack-size) 1)] ["Solve equation (2:) numerically [initial guess = (1:)]" (progn (require 'calcalg3) (call-interactively 'calc-find-root)) - :keys "a R"] + :keys "a R" + :active (>= (calc-stack-size) 2)] ["Find roots of polynomial (1:)" (progn (require 'calcalg2) (call-interactively 'calc-poly-roots)) - :keys "a P"]) + :keys "a P" + :active (>= (calc-stack-size) 1)]) (list "Curve Fitting" ["Fit (1:)=[x values, y values] to a curve" (progn (require 'calcalg3) (call-interactively 'calc-curve-fit)) - :keys "a F"]) + :keys "a F" + :active (>= (calc-stack-size) 1)]) "----" ["Help on Algebra" (calc-info-goto-node "Algebra")]) @@ -591,12 +681,14 @@ (progn (require 'calc-graph) (call-interactively 'calc-graph-fast)) - :keys "g f"] + :keys "g f" + :active (>= (calc-stack-size) 2)] ["Graph 3D [(1:)= z values, (2:)= y values, (3:)= x values]" (progn (require 'calc-graph) (call-interactively 'calc-graph-fast-3d)) - :keys "g F"] + :keys "g F" + :active (>= (calc-stack-size) 3)] "----" ["Help on Graphics" (calc-info-goto-node "Graphics")]) @@ -606,14 +698,18 @@ (defvar calc-vectors-menu (list "Matrices/Vectors" (list "Matrices" - ["(2:) + (1:)" calc-plus :keys "+"] - ["(2:) - (1:)" calc-minus :keys "-"] - ["(2:) * (1:)" calc-times :keys "*"] - ["(1:)^(-1)" + ["(2:) + (1:)" calc-plus + :keys "+" :active (>= (calc-stack-size) 2)] + ["(2:) - (1:)" calc-minus + :keys "-" :active (>= (calc-stack-size) 2)] + ["(2:) * (1:)" calc-times + :keys "*" :active (>= (calc-stack-size) 2)] + ["(1:)^(-1)" (progn (require 'calc-arith) (call-interactively 'calc-inv)) - :keys "&"] + :keys "&" + :active (>= (calc-stack-size) 1)] ["Create an identity matrix" (progn (require 'calc-vec) @@ -623,179 +719,211 @@ (progn (require 'calc-vec) (call-interactively 'calc-transpose)) - :keys "v t"] + :keys "v t" + :active (>= (calc-stack-size) 1)] ["det(1:)" (progn (require 'calc-mtx) (call-interactively 'calc-mdet)) - :keys "V D"] + :keys "V D" + :active (>= (calc-stack-size) 1)] ["trace(1:)" (progn (require 'calc-mtx) (call-interactively 'calc-mtrace)) - :keys "V T"] + :keys "V T" + :active (>= (calc-stack-size) 1)] ["LUD decompose (1:)" (progn (require 'calc-mtx) (call-interactively 'calc-mlud)) - :keys "V L"] + :keys "V L" + :active (>= (calc-stack-size) 1)] ["Extract a row from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-mrow)) - :keys "v r"] + :keys "v r" + :active (>= (calc-stack-size) 1)] ["Extract a column from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-mcol)) - :keys "v c"]) + :keys "v c" + :active (>= (calc-stack-size) 1)]) (list "Vectors" ["Extract the first element of (1:)" (progn (require 'calc-vec) (call-interactively 'calc-head)) - :keys "v h"] + :keys "v h" + :active (>= (calc-stack-size) 1)] ["Extract an element from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-mrow)) - :keys "v r"] + :keys "v r" + :active (>= (calc-stack-size) 1)] ["Reverse (1:)" (progn (require 'calc-vec) (call-interactively 'calc-reverse-vector)) - :keys "v v"] + :keys "v v" + :active (>= (calc-stack-size) 1)] ["Unpack (1:)" (progn (require 'calc-vec) (call-interactively 'calc-unpack)) :keys "v u" + :active (>= (calc-stack-size) 1) :help "Separate the elements of (1:)"] ["(2:) cross (1:)" (progn (require 'calc-vec) (call-interactively 'calc-cross)) :keys "V C" + :active (>= (calc-stack-size) 2) :help "The cross product in R^3"] ["(2:) dot (1:)" calc-mult :keys "*" + :active (>= (calc-stack-size) 2) :help "The dot product"] ["Map a function across (1:)" (progn (require 'calc-map) (call-interactively 'calc-map)) :keys "V M" + :active (>= (calc-stack-size) 1) :help "Apply a function to each element"]) (list "Vectors As Sets" ["Remove duplicates from (1:)" (progn (require 'calc-vec) (call-interactively 'calc-remove-duplicates)) - :keys "V +"] + :keys "V +" + :active (>= (calc-stack-size) 1)] ["(2:) union (1:)" (progn (require 'calc-vec) (call-interactively 'calc-set-union)) - :keys "V V"] + :keys "V V" + :active (>= (calc-stack-size) 2)] ["(2:) intersect (1:)" (progn (require 'calc-vec) (call-interactively 'calc-set-intersect)) - :keys "V ^"] + :keys "V ^" + :active (>= (calc-stack-size) 2)] ["(2:) \\ (1:)" (progn (require 'calc-vec) (call-interactively 'calc-set-difference)) :keys "V -" - :help "Set difference"]) + :help "Set difference" + :active (>= (calc-stack-size) 2)]) (list "Statistics On Vectors" ["length(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-count)) :keys "u #" + :active (>= (calc-stack-size) 1) :help "The number of data values"] ["sum(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-sum)) :keys "u +" + :active (>= (calc-stack-size) 1) :help "The sum of the data values"] ["max(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-max)) :keys "u x" + :active (>= (calc-stack-size) 1) :help "The maximum of the data values"] ["min(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-min)) :keys "u N" + :active (>= (calc-stack-size) 1) :help "The minumum of the data values"] ["mean(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-mean)) :keys "u M" + :active (>= (calc-stack-size) 1) :help "The average (arithmetic mean) of the data values"] ["mean(1:) with error" (progn (require 'calc-stat) (call-interactively 'calc-vector-mean-error)) :keys "I u M" + :active (>= (calc-stack-size) 1) :help "The average (arithmetic mean) of the data values as an error form"] ["sdev(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-sdev)) :keys "u S" + :active (>= (calc-stack-size) 1) :help "The sample sdev, sqrt[sum((values - mean)^2)/(N-1)]"] ["variance(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-variance)) :keys "H u S" + :active (>= (calc-stack-size) 1) :help "The sample variance, sum((values - mean)^2)/(N-1)"] ["population sdev(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-pop-sdev)) :keys "I u S" + :active (>= (calc-stack-size) 1) :help "The population sdev, sqrt[sum((values - mean)^2)/N]"] ["population variance(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-pop-variance)) :keys "H I u S" + :active (>= (calc-stack-size) 1) :help "The population variance, sum((values - mean)^2)/N"] ["median(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-median)) :keys "H u M" + :active (>= (calc-stack-size) 1) :help "The median of the data values"] ["harmonic mean(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-harmonic-mean)) - :keys "H I u M"] + :keys "H I u M" + :active (>= (calc-stack-size) 1)] ["geometric mean(1:)" (progn (require 'calc-stat) (call-interactively 'calc-vector-geometric-mean)) - :keys "u G"] + :keys "u G" + :active (>= (calc-stack-size) 1)] ["arithmetic-geometric mean(1:)" (progn (require 'calc-stat) (let ((calc-hyperbolic-flag t)) (call-interactively 'calc-vector-geometric-mean))) - :keys "H u G"] + :keys "H u G" + :active (>= (calc-stack-size) 1)] ["RMS(1:)" (progn (require 'calc-arith) (call-interactively 'calc-abs)) :keys "A" + :active (>= (calc-stack-size) 1) :help "The root-mean-square, or quadratic mean"]) ["Abbreviate long vectors" (progn @@ -815,17 +943,20 @@ (progn (require 'calc-units) (call-interactively 'calc-convert-units )) - :keys "u c"] + :keys "u c" + :active (>= (calc-stack-size) 1)] ["Convert temperature in (1:)" (progn (require 'calc-units) (call-interactively 'calc-convert-temperature)) - :keys "u t"] + :keys "u t" + :active (>= (calc-stack-size) 1)] ["Simplify units in (1:)" (progn (require 'calc-units) (call-interactively 'calc-simplify-units)) - :keys "u s"] + :keys "u s" + :active (>= (calc-stack-size) 1)] ["View units table" (progn (require 'calc-units) @@ -842,7 +973,8 @@ (progn (require 'calc-store) (call-interactively 'calc-store)) - :keys "s s"] + :keys "s s" + :active (>= (calc-stack-size) 1)] ["Recall a variable value" (progn (require 'calc-store) @@ -857,7 +989,8 @@ (progn (require 'calc-store) (call-interactively 'calc-store-exchange)) - :keys "s x"] + :keys "s x" + :active (>= (calc-stack-size) 1)] ["Clear variable value" (progn (require 'calc-store) @@ -867,12 +1000,14 @@ (progn (require 'calc-ext) (call-interactively 'calc-evaluate)) - :keys "="] + :keys "=" + :active (>= (calc-stack-size) 1)] ["Evaluate (1:), assigning a value to a variable" (progn (require 'calc-store) (call-interactively 'calc-let)) :keys "s l" + :active (>= (calc-stack-size) 1) :help "Evaluate (1:) under a temporary assignment of a variable"] "----" ["Help on Variables" @@ -883,18 +1018,22 @@ (list "Stack" ["Remove (1:)" calc-pop - :keys "DEL"] + :keys "DEL" + :active (>= (calc-stack-size) 1)] ["Switch (1:) and (2:)" calc-roll-down - :keys "TAB"] + :keys "TAB" + :active (>= (calc-stack-size) 2)] ["Duplicate (1:)" calc-enter - :keys "RET"] + :keys "RET" + :active (>= (calc-stack-size) 1)] ["Edit (1:)" (progn (require 'calc-yank) (call-interactively calc-edit)) - :keys "`"] + :keys "`" + :active (>= (calc-stack-size) 1)] "----" ["Help on Stack" (calc-info-goto-node "Stack and Trail")]) @@ -1051,6 +1190,47 @@ :keys "d e" :style radio :selected (eq (car-safe calc-float-format) 'eng)]) + (list "Complex Format" + ["Default" + (progn + (require 'calc-cplx) + (calc-complex-notation)) + :style radio + :selected (not calc-complex-format) + :keys "d c" + :help "Display complex numbers as ordered pairs."] + ["i notation" + (progn + (require 'calc-cplx) + (calc-i-notation)) + :style radio + :selected (eq calc-complex-format 'i) + :keys "d i" + :help "Display complex numbers as a+bi."] + ["j notation" + (progn + (require 'calc-cplx) + (calc-i-notation)) + :style radio + :selected (eq calc-complex-format 'j) + :keys "d j" + :help "Display complex numbers as a+bj."] + ["Other" + (calc-complex-notation) + :style radio + :selected (and calc-complex-format + (not (eq calc-complex-format 'i)) + (not (eq calc-complex-format 'j))) + :active nil] + "----" + ["Polar mode" + (progn + (require 'calc-cplx) + (calc-polar-mode nil)) + :style toggle + :selected (eq calc-complex-mode 'polar) + :keys "m p" + :help "Prefer polar form for complex numbers."]) (list "Algebraic" ["Normal" (progn @@ -1178,7 +1358,21 @@ (call-interactively 'calc-giac-language)) :keys "d A" :style radio - :selected (eq calc-language 'giac)]) + :selected (eq calc-language 'giac)] + ["Mma" + (progn + (require 'calc-lang) + (call-interactively 'calc-mathematica-language)) + :keys "d M" + :style radio + :selected (eq calc-language 'math)] + ["Maple" + (progn + (require 'calc-lang) + (call-interactively 'calc-maple-language)) + :keys "d W" + :style radio + :selected (eq calc-language 'maple)]) "----" ["Save mode settings" calc-save-modes :keys "m m"] "----" diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index a7c4b20e30..ac1c0cd008 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -491,9 +491,14 @@ If EXPR is nil, return nil." (when (eq (car-safe unew) 'error) (error "Bad format in units expression: %s" (nth 2 unew))) (math-put-default-units unew) - (calc-enter-result 1 "cvtm" (math-simplify-units - (math-convert-temperature expr uold unew - uoldname)))))) + (let ((ntemp (calc-normalize + (math-simplify-units + (math-convert-temperature expr uold unew + uoldname))))) + (if (Math-zerop ntemp) + (setq ntemp (list '* ntemp unew))) + (let ((calc-simplify-mode 'none)) + (calc-enter-result 1 "cvtm" ntemp)))))) (defun calc-remove-units () (interactive) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index b9e462ec05..b46981f137 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1395,7 +1395,7 @@ that are not customizable options, as well as faces and groups (defun customize-apropos-options (regexp &optional arg) "Customize all loaded customizable options matching REGEXP. With prefix arg, include variables that are not customizable options -\(but we recommend using `apropos-variable' instead)." +\(but it is better to use `apropos-variable' if you want to find those)." (interactive "sCustomize options (regexp): \nP") (customize-apropos regexp (or arg 'options))) @@ -2258,7 +2258,8 @@ Insert PREFIX first if non-nil." (insert ", ")))) (widget-put widget :buttons buttons)))) -(defun custom-add-parent-links (widget &optional initial-string) +(defun custom-add-parent-links (widget &optional initial-string + doc-initial-string) "Add \"Parent groups: ...\" to WIDGET if the group has parents. The value is non-nil if any parents were found. If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." @@ -2267,7 +2268,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (buttons (widget-get widget :buttons)) (start (point)) (parents nil)) - (insert (or initial-string "Parent groups:")) + (insert (or initial-string "Groups:")) (mapatoms (lambda (symbol) (when (member (list name type) (get symbol 'custom-group)) (insert " ") @@ -2286,23 +2287,27 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (get (car parents) 'custom-links)))) (many (> (length links) 2))) (when links - (insert "\nParent documentation: ") - (while links - (push (widget-create-child-and-convert - widget (car links) - :button-face 'custom-link - :mouse-face 'highlight - :pressed-face 'highlight) - buttons) - (setq links (cdr links)) - (cond ((null links) - (insert ".\n")) - ((null (cdr links)) - (if many - (insert ", and ") - (insert " and "))) - (t - (insert ", "))))))) + (let ((pt (point)) + (left-margin (+ left-margin 2))) + (insert "\n" (or doc-initial-string "Group documentation:") " ") + (while links + (push (widget-create-child-and-convert + widget (car links) + :button-face 'custom-link + :mouse-face 'highlight + :pressed-face 'highlight) + buttons) + (setq links (cdr links)) + (cond ((null links) + (insert ".\n")) + ((null (cdr links)) + (if many + (insert ", and ") + (insert " and "))) + (t + (insert ", ")))) + (fill-region-as-paragraph pt (point)) + (delete-to-left-margin (1+ pt) (+ pt 2)))))) (if parents (insert "\n") (delete-region start (point))) @@ -3496,10 +3501,10 @@ Optional EVENT is the location for the menu." (put symbol 'customized-face value) (custom-push-theme 'theme-face symbol 'user 'set value) (if (face-spec-choose value) - (face-spec-set symbol value) + (face-spec-set symbol value t) ;; face-set-spec ignores empty attribute lists, so just give it ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)))) + (face-spec-set symbol '((t :foreground unspecified)) t)) (put symbol 'customized-face-comment comment) (put symbol 'face-comment comment) (custom-face-state-set widget) @@ -3518,10 +3523,10 @@ Optional EVENT is the location for the menu." (custom-comment-hide comment-widget)) (custom-push-theme 'theme-face symbol 'user 'set value) (if (face-spec-choose value) - (face-spec-set symbol value) + (face-spec-set symbol value t) ;; face-set-spec ignores empty attribute lists, so just give it ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)))) + (face-spec-set symbol '((t :foreground unspecified)) t)) (unless (eq (widget-get widget :custom-state) 'standard) (put symbol 'saved-face value)) (put symbol 'customized-face nil) @@ -3548,7 +3553,7 @@ Optional EVENT is the location for the menu." (put symbol 'customized-face nil) (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'set value) - (face-spec-set symbol value) + (face-spec-set symbol value t) (put symbol 'face-comment comment) (widget-value-set child value) ;; This call manages the comment visibility @@ -3572,7 +3577,7 @@ restoring it to the state of a face that has never been customized." (put symbol 'customized-face nil) (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'reset) - (face-spec-set symbol value) + (face-spec-set symbol value t) (custom-theme-recalc-face symbol) (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) (put symbol 'saved-face nil) @@ -3894,7 +3899,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;;; was made to display a group. (when (eq level 1) (if (custom-add-parent-links widget - "Parent groups:") + "Parent groups:" + "Parent group documentation:") (insert "\n")))) ;; Create level indicator. (insert-char ?\ (* custom-buffer-indent (1- level))) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 92274dcbe2..dfc5babec8 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -46,7 +46,7 @@ (make-empty-face face) ;; Create frame-local faces (dolist (frame (frame-list)) - (face-spec-set face value frame) + (face-spec-set-2 face frame value) (when (memq (window-system frame) '(x w32 mac)) (setq have-window-system t))) ;; When making a face after frames already exist @@ -342,7 +342,8 @@ FACE's list property `theme-face' \(using `custom-push-theme')." (unless (facep face) (make-empty-face face)) (put face 'face-comment comment) - (face-spec-set face spec nil)) + (put face 'face-override-spec nil) + (face-spec-set face spec t)) (setq args (cdr args))) ;; Old format, a plist of FACE SPEC pairs. (let ((face (nth 0 args)) diff --git a/lisp/custom.el b/lisp/custom.el index bbee71ecf1..d39bbb37e0 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1176,9 +1176,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE." (defun custom-theme-recalc-face (face) "Set FACE according to currently enabled custom themes." (if (facep face) - (let ((theme-faces (reverse (get face 'theme-face)))) - (dolist (spec theme-faces) - (face-spec-set face (cadr spec)))))) + (face-spec-recalc face))) ;;; XEmacs compability functions diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index c4ba3e4ca9..0ef9cc89ba 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -596,20 +596,39 @@ displayed." symname))))) elp-all-instrumented-list)) ) ; end let* - (insert title) - (if (> longest titlelen) - (progn - (insert-char 32 (- longest titlelen)) - (setq elp-field-len longest))) - (insert " " cc-header " " et-header " " at-header "\n") - (insert-char ?= elp-field-len) - (insert " ") - (insert-char ?= elp-cc-len) - (insert " ") - (insert-char ?= elp-et-len) - (insert " ") - (insert-char ?= elp-at-len) - (insert "\n") + ;; If printing to stdout, insert the header so it will print. + ;; Otherwise use header-line-format. + (setq elp-field-len (max titlelen longest)) + (if (or elp-use-standard-output noninteractive) + (progn + (insert title) + (if (> longest titlelen) + (progn + (insert-char 32 (- longest titlelen)))) + (insert " " cc-header " " et-header " " at-header "\n") + (insert-char ?= elp-field-len) + (insert " ") + (insert-char ?= elp-cc-len) + (insert " ") + (insert-char ?= elp-et-len) + (insert " ") + (insert-char ?= elp-at-len) + (insert "\n")) + (let ((column 0)) + (setq header-line-format + (mapconcat + (lambda (title) + (prog1 + (concat + (propertize " " + 'display (list 'space :align-to column) + 'face 'fixed-pitch) + title) + (setq column (+ column 1 + (if (= column 0) + elp-field-len + (length title)))))) + (list title cc-header et-header at-header) "")))) ;; if sorting is enabled, then sort the results list. in either ;; case, call elp-output-result to output the result in the ;; buffer @@ -621,7 +640,8 @@ displayed." (pop-to-buffer resultsbuf) ;; copy results to standard-output? (if (or elp-use-standard-output noninteractive) - (princ (buffer-substring (point-min) (point-max)))) + (princ (buffer-substring (point-min) (point-max))) + (goto-char (point-min))) ;; reset profiling info if desired (and elp-reset-after-results (elp-reset-all)))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 968a115c5d..61a6f52f55 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -541,14 +541,14 @@ argument BUFFER-NAME is nil, it defaults to *Colors*." (insert (car color)) (indent-to 22)) (point) - 'face (cons 'background-color (car color))) + 'face (list ':background (car color))) (put-text-property (prog1 (point) (insert " " (if (cdr color) (mapconcat 'identity (cdr color) ", ") (car color)))) (point) - 'face (cons 'foreground-color (car color))) + 'face (list ':foreground (car color))) (indent-to (max (- (window-width) 8) 44)) (insert (apply 'format "#%02x%02x%02x" (mapcar (lambda (c) (lsh c -8)) diff --git a/lisp/faces.el b/lisp/faces.el index 75fe47022a..11d9ba7b8e 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -276,10 +276,8 @@ The optional argument FRAME is ignored." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun facep (face) - "Return non-nil if FACE is a face name or internal face object. -Return nil otherwise. A face name can be a string or a symbol. -An internal face object is a vector of the kind used internally -to record face data." + "Return non-nil if FACE is a face name; nil otherwise. +A face name can be a string or a symbol." (internal-lisp-face-p face)) @@ -319,9 +317,7 @@ If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (let ((attrs - '(:family :width :height :weight :slant :foreground - :background :underline :overline :strike-through - :box :inverse-video)) + (delq :inherit (mapcar 'car face-attribute-name-alist))) (differs nil)) (while (and attrs (not differs)) (let* ((attr (pop attrs)) @@ -423,6 +419,17 @@ FRAME nil or not specified means do it for all frames." (symbol-name (check-face face))) +(defun face-all-attributes (face &optional frame) + "Return an alist stating the attributes of FACE. +Each element of the result has the form (ATTR-NAME . ATTR-VALUE). +Normally the value describes the default attributes, +but if you specify FRAME, the value describes the attributes +of FACE on FRAME." + (mapcar (lambda (pair) + (let ((attr (car pair))) + (cons attr (face-attribute face attr (or frame t))))) + face-attribute-name-alist)) + (defun face-attribute (face attribute &optional frame inherit) "Return the value of FACE's ATTRIBUTE on FRAME. If the optional argument FRAME is given, report on face FACE in that frame. @@ -1516,46 +1523,79 @@ If SPEC is nil, return nil." (setq attrs (cdr attrs))))) -(defun face-spec-set (face spec &optional frame) - "Set FACE's attributes according to the first matching entry in SPEC. -FRAME is the frame whose frame-local face is set. FRAME nil means -do it on all frames (and change the default for new frames). -See `defface' for information about SPEC. If SPEC is nil, do nothing." - (let ((attrs (face-spec-choose spec frame))) - (when spec - (face-spec-reset-face face (or frame t))) - (while attrs - (let ((attribute (car attrs)) - (value (car (cdr attrs)))) - ;; Support some old-style attribute names and values. - (case attribute - (:bold (setq attribute :weight value (if value 'bold 'normal))) - (:italic (setq attribute :slant value (if value 'italic 'normal))) - ((:foreground :background) - ;; Compatibility with 20.x. Some bogus face specs seem to - ;; exist containing things like `:foreground nil'. - (if (null value) (setq value 'unspecified))) - (t (unless (assq attribute face-x-resources) - (setq attribute nil)))) - (when attribute - ;; If frame is nil, set the default for new frames. - ;; Existing frames are handled below. - (set-face-attribute face (or frame t) attribute value))) - (setq attrs (cdr (cdr attrs))))) - (unless frame - ;; When we reset the face based on its spec, then it is unmodified - ;; as far as Custom is concerned. - (put (or (get face 'face-alias) face) 'face-modified nil) -;;; ;; Clear all the new-frame defaults for this face. +(defun face-spec-set (face spec &optional for-defface) + "Set FACE's face spec, which controls its appearance, to SPEC> +If FOR-DEFFACE is t, set the base spec, the one that `defface' + and Custom set. (In that case, the caller must put it in the + appropriate property, because that depends on the caller.) +If FOR-DEFFACE is nil, set the overriding spec (and store it + in the `face-override-spec' property of FACE). + +The appearance of FACE is controlled by the base spec, +by any custom theme specs on top of that, and by the +the overriding spec on top of all the rest. + +FOR-DEFFACE can also be a frame, in which case we set the +frame-specific attributes of FACE for that frame based on SPEC. +That usage is deprecated. + +See `defface' for information about the format and meaning of SPEC." + (if (framep for-defface) + ;; Handle the deprecated case where third arg is a frame. + (face-spec-set-2 face for-defface spec) + (if for-defface + ;; When we reset the face based on its custom spec, then it is + ;; unmodified as far as Custom is concerned. + (put (or (get face 'face-alias) face) 'face-modified nil) + ;; When we change a face based on a spec from outside custom, + ;; record it for future frames. + (put (or (get face 'face-alias) face) 'face-override-spec spec)) +;;; RMS 29 dec 2007: Perhaps this code should be reinstated. +;;; That depends on whether the overriding spec +;;; or the default face attributes +;;; should take priority. +;;; ;; Clear all the new-frame default attributes for this face. ;;; ;; face-spec-reset-face won't do it right. ;;; (let ((facevec (cdr (assq face face-new-frame-defaults)))) ;;; (dotimes (i (length facevec)) ;;; (unless (= i 0) ;;; (aset facevec i 'unspecified)))) - ;; Set each frame according to the rules implied by SPEC. + ;; Reset each frame according to the rules implied by all its specs. (dolist (frame (frame-list)) - (face-spec-set face spec frame)))) - + (face-spec-recalc face frame)))) + +(defun face-spec-recalc (face frame) + "Reset the face attributes of FACE on FRAME according to its specs. +This applies the defface/custom spec first, then the custom theme specs, +then the override spec." + (face-spec-reset-face face frame) + (let ((face-sym (or (get face 'face-alias) face))) + (face-spec-set-2 face frame + (face-user-default-spec face)) + (let ((theme-faces (reverse (get face-sym 'theme-face)))) + (dolist (spec theme-faces) + (face-spec-set-2 face frame (cadr spec)))) + (face-spec-set-2 face frame (get face-sym 'face-override-spec)))) + +(defun face-spec-set-2 (face frame spec) + "Set the face attributes of FACE on FRAME according to SPEC." + (let* ((attrs (face-spec-choose spec frame))) + (while attrs + (let ((attribute (car attrs)) + (value (car (cdr attrs)))) + ;; Support some old-style attribute names and values. + (case attribute + (:bold (setq attribute :weight value (if value 'bold 'normal))) + (:italic (setq attribute :slant value (if value 'italic 'normal))) + ((:foreground :background) + ;; Compatibility with 20.x. Some bogus face specs seem to + ;; exist containing things like `:foreground nil'. + (if (null value) (setq value 'unspecified))) + (t (unless (assq attribute face-x-resources) + (setq attribute nil)))) + (when attribute + (set-face-attribute face frame attribute value))) + (setq attrs (cdr (cdr attrs)))))) (defun face-attr-match-p (face attrs &optional frame) "Return t if attributes of FACE match values in plist ATTRS. @@ -1868,14 +1908,16 @@ according to the `background-mode' and `display-type' frame parameters." (let ((locally-modified-faces nil)) ;; Before modifying the frame parameters, we collect a list of ;; faces that don't match what their face-spec says they should - ;; look like; we then avoid changing these faces below. A - ;; negative list is used on the assumption that most faces will + ;; look like; we then avoid changing these faces below. + ;; These are the faces whose attributes were modified on FRAME. + ;; We use a negative list on the assumption that most faces will ;; be unmodified, so we can avoid consing in the common case. (dolist (face (face-list)) - (when (not (face-spec-match-p face - (face-user-default-spec face) - (selected-frame))) - (push face locally-modified-faces))) + (and (not (get face 'face-override-spec)) + (not (face-spec-match-p face + (face-user-default-spec face) + (selected-frame))) + (push face locally-modified-faces))) ;; Now change to the new frame parameters (modify-frame-parameters frame (list (cons 'background-mode bg-mode) @@ -1884,7 +1926,7 @@ according to the `background-mode' and `display-type' frame parameters." ;; parameters, unless they have been locally modified. (dolist (face (face-list)) (unless (memq face locally-modified-faces) - (face-spec-set face (face-user-default-spec face) frame))))))) + (face-spec-recalc face frame))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2018,7 +2060,7 @@ Initialize colors of certain faces from frame parameters." (dolist (face (delq 'default (face-list))) (condition-case () (progn - (face-spec-set face (face-user-default-spec face) frame) + (face-spec-recalc face frame) (if (memq (window-system frame) '(x w32 mac)) (make-face-x-resource-internal face frame)) (internal-merge-in-global-face face frame)) diff --git a/lisp/files.el b/lisp/files.el index dec47ce362..75dfb089c5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -635,10 +635,10 @@ Directories are separated by occurrences of `path-separator' (if (file-exists-p dir) (error "%s is not a directory" dir) (error "%s: no such directory" dir)) - (if (file-executable-p dir) - (setq default-directory dir - list-buffers-directory dir) - (error "Cannot cd to %s: Permission denied" dir)))) + (unless (file-executable-p dir) + (error "Cannot cd to %s: Permission denied" dir)) + (setq default-directory dir) + (set (make-local-variable 'list-buffers-directory) dir))) (defun cd (dir) "Make DIR become the current buffer's default directory. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index f7cc4da0aa..147b98f5a5 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1303,6 +1303,12 @@ Optional argument OBJECT is the string or buffer containing the text." (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) + ;; Canonicalize old forms of face property. + (and (memq prop '(face font-lock-face)) + (listp prev) + (or (keywordp (car prev)) + (memq (car prev) '(foreground-color background-color))) + (setq prev (list prev))) (put-text-property start next prop (append val (if (listp prev) prev (list prev))) object) @@ -1317,6 +1323,12 @@ Optional argument OBJECT is the string or buffer containing the text." (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) + ;; Canonicalize old forms of face property. + (and (memq prop '(face font-lock-face)) + (listp prev) + (or (keywordp (car prev)) + (memq (car prev) '(foreground-color background-color))) + (setq prev (list prev))) (put-text-property start next prop (append (if (listp prev) prev (list prev)) val) object) diff --git a/lisp/man.el b/lisp/man.el index 48639cd764..1f4288bc80 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -642,50 +642,91 @@ a new value." ;; ====================================================================== -;; default man entry: get word under point +;; default man entry: get word near point -(defsubst Man-default-man-entry (&optional pos) - "Make a guess at a default manual entry based on the text at POS. -If POS is nil, the current point is used." - (let (word start original-pos distance) +(defun Man-default-man-entry (&optional pos) + "Guess default manual entry based on the text near position POS. +POS defaults to `point'." + (let (word start pos column distance) (save-excursion - (if pos (goto-char pos)) - ;; Default man entry title is any word the cursor is on, or if - ;; cursor not on a word, nearest preceding or next word-like - ;; object on this line. - (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) + (when pos (goto-char pos)) + (setq pos (point)) + ;; The default title is the nearest entry-like object before or + ;; after POS. + (if (and (skip-chars-backward " \ta-zA-Z0-9+") + (not (zerop (skip-chars-backward "("))) + ;; Try to handle the special case where POS is on a + ;; section number. + (looking-at + (concat "([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) + ;; We skipped a valid section number backwards, look at + ;; preceding text. + (or (and (skip-chars-backward ",; \t") + (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))) + ;; Not a valid entry, move POS after closing paren. + (not (setq pos (match-end 0))))) + ;; We have a candidate, make `start' record its starting + ;; position. (setq start (point)) - (setq original-pos (point)) - (setq distance (abs (skip-chars-backward ",; \t"))) + ;; Otherwise look at char before POS. + (goto-char pos) (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) - (progn - (setq start (point)) - (goto-char original-pos) - (if (and (< (skip-chars-forward ",; \t") distance) - (looking-at "[-a-zA-Z0-9._+:]")) - (setq start (point)) - (goto-char start))) - (skip-chars-forward ",; \t") - (setq start (point)))) + ;; Our candidate is just before or around POS. + (setq start (point)) + ;; Otherwise record the current column and look backwards. + (setq column (current-column)) + (skip-chars-backward ",; \t") + ;; Record the distance travelled. + (setq distance (- column (current-column))) + (when (looking-back + (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)")) + ;; Skip section number backwards. + (goto-char (match-beginning 0)) + (skip-chars-backward " \t")) + (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) + (progn + ;; We have a candidate before POS ... + (setq start (point)) + (goto-char pos) + (if (and (skip-chars-forward ",; \t") + (< (- (current-column) column) distance) + (looking-at "[-a-zA-Z0-9._+:]")) + ;; ... but the one after POS is better. + (setq start (point)) + ;; ... and anything after POS is worse. + (goto-char start))) + ;; No candidate before POS. + (goto-char pos) + (skip-chars-forward ",; \t") + (setq start (point))))) + ;; We have found a suitable starting point, try to skip at least + ;; one character. (skip-chars-forward "-a-zA-Z0-9._+:") (setq word (buffer-substring-no-properties start (point))) ;; If there is a continuation at the end of line, check the ;; following line too, eg: ;; see this- ;; command-here(1) + ;; Note: This code gets executed iff our entry is after POS. (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") - (setq word (concat word (match-string-no-properties 1)))) + (setq word (concat word (match-string-no-properties 1))) + ;; Make sure the section number gets included by the code below. + (goto-char (match-end 1))) (when (string-match "[._]+$" word) (setq word (substring word 0 (match-beginning 0)))) - ;; If looking at something like *strcat(... , remove the '*' - (when (string-match "^*" word) - (setq word (substring word 1))) - ;; If looking at something like ioctl(2) or brc(1M), include the - ;; section number in the returned value. Remove text properties. - (concat word - (if (looking-at - (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) - (format "(%s)" (match-string-no-properties 1))))))) + ;; The following was commented out since the preceding code + ;; should not produce a leading "*" in the first place. +;;; ;; If looking at something like *strcat(... , remove the '*' +;;; (when (string-match "^*" word) +;;; (setq word (substring word 1))) + (concat + word + (and (not (string-equal word "")) + ;; If looking at something like ioctl(2) or brc(1M), + ;; include the section number in the returned value. + (looking-at + (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) + (format "(%s)" (match-string-no-properties 1))))))) ;; ====================================================================== diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 75bcb8ed13..1c1016aed9 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -64,33 +64,50 @@ hash table." dbus-registered-functions-table) result)) -(defun dbus-name-owner-changed-handler (service old-owner new-owner) +(defun dbus-name-owner-changed-handler (&rest args) "Reapplies all signal registrations to D-Bus. This handler is applied when a \"NameOwnerChanged\" signal has arrived. SERVICE is the object name for which the name owner has been changed. OLD-OWNER is the previous owner of SERVICE, or the empty string if SERVICE was not owned yet. NEW-OWNER is the new -owner of SERVICE, or the empty string if SERVICE looses any name owner." +owner of SERVICE, or the empty string if SERVICE looses any name owner. + +usage: (dbus-name-owner-changed-handler service old-owner new-owner)" (save-match-data - ;; Check whether SERVICE is a known name. - (when (and (stringp service) (not (string-match "^:" service)) - (stringp old-owner) (stringp new-owner)) - (maphash - '(lambda (key value) - (dolist (elt value) - ;; key has the structure (BUS INTERFACE SIGNAL). - ;; elt has the structure (UNAME SERVICE PATH HANDLER). - (when (string-equal old-owner (car elt)) - ;; Remove old key, and add new entry with changed name. - (dbus-unregister-signal (list key (cdr elt))) - ;; Maybe we could arrange the lists a little bit better - ;; that we don't need to extract every single element? - (dbus-register-signal - ;; BUS SERVICE PATH - (nth 0 key) (nth 1 elt) (nth 2 elt) - ;; INTERFACE SIGNAL HANDLER - (nth 1 key) (nth 2 key) (nth 3 elt))))) - (copy-hash-table dbus-registered-functions-table))))) + ;; Check the arguments. We should silently ignore it when they + ;; are wrong. + (if (and (= (length args) 3) + (stringp (car args)) + (stringp (cadr args)) + (stringp (caddr args))) + (let ((service (car args)) + (old-owner (cadr args)) + (new-owner (caddr args))) + ;; Check whether SERVICE is a known name. + (when (not (string-match "^:" service)) + (maphash + '(lambda (key value) + (dolist (elt value) + ;; key has the structure (BUS INTERFACE SIGNAL). + ;; elt has the structure (UNAME SERVICE PATH HANDLER). + (when (string-equal old-owner (car elt)) + ;; Remove old key, and add new entry with changed name. + (dbus-unregister-signal (list key (cdr elt))) + ;; Maybe we could arrange the lists a little bit better + ;; that we don't need to extract every single element? + (dbus-register-signal + ;; BUS SERVICE PATH + (nth 0 key) (nth 1 elt) (nth 2 elt) + ;; INTERFACE SIGNAL HANDLER + (nth 1 key) (nth 2 key) (nth 3 elt))))) + (copy-hash-table dbus-registered-functions-table)))) + ;; The error is reported only in debug mode. + (when dbus-debug + (signal + 'dbus-error + (cons + (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus) + args)))))) ;; Register the handler. (condition-case nil @@ -148,11 +165,11 @@ part of the event, is called with arguments ARGS." (interactive "e") ;; We don't want to raise an error, because this function is called ;; in the event handling loop. - (condition-case nil + (condition-case err (progn (dbus-check-event event) (apply (nth 6 event) (nthcdr 7 event))) - (dbus-error))) + (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) (defun dbus-event-bus-name (event) "Return the bus name the event is coming from. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index a1a0e0ca8e..06e5c1ad67 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1480,32 +1480,47 @@ record activity." (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) +(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name + "A function to generate the filename used by rcirc's logging facility. + +It is called with two arguments, PROCESS and TARGET (see +`rcirc-generate-new-buffer-name' for their meaning), and should +return the filename, or nil if no logging is desired for this +session. + +If the returned filename is absolute (`file-name-absolute-p' +returns true), then it is used as-is, otherwise the resulting +file is put into `rcirc-log-directory'." + :group 'rcirc + :type 'function) + (defun rcirc-log (process sender response target text) "Record line in `rcirc-log', to be later written to disk." - (let* ((filename (rcirc-generate-new-buffer-name process target)) - (cell (assoc-string filename rcirc-log-alist)) - (line (concat (format-time-string rcirc-time-format) - (substring-no-properties - (rcirc-format-response-string process sender - response target text)) - "\n"))) - (if cell - (setcdr cell (concat (cdr cell) line)) - (setq rcirc-log-alist - (cons (cons filename line) rcirc-log-alist))))) + (let ((filename (funcall rcirc-log-filename-function process target))) + (unless (null filename) + (let ((cell (assoc-string filename rcirc-log-alist)) + (line (concat (format-time-string rcirc-time-format) + (substring-no-properties + (rcirc-format-response-string process sender + response target text)) + "\n"))) + (if cell + (setcdr cell (concat (cdr cell) line)) + (setq rcirc-log-alist + (cons (cons filename line) rcirc-log-alist))))))) (defun rcirc-log-write () "Flush `rcirc-log-alist' data to disk. -Log data is written to `rcirc-log-directory'." - (make-directory rcirc-log-directory t) +Log data is written to `rcirc-log-directory', except for +log-files with absolute names (see `rcirc-log-filename-function')." (dolist (cell rcirc-log-alist) - (with-temp-buffer - (insert (cdr cell)) - (let ((coding-system-for-write 'utf-8)) - (write-region (point-min) (point-max) - (concat rcirc-log-directory "/" (car cell)) - t 'quiet)))) + (let ((filename (expand-file-name (car cell) rcirc-log-directory)) + (coding-system-for-write 'utf-8)) + (make-directory (file-name-directory filename) t) + (with-temp-buffer + (insert (cdr cell)) + (write-region (point-min) (point-max) filename t 'quiet)))) (setq rcirc-log-alist nil)) (defun rcirc-join-channels (process channels) diff --git a/lisp/startup.el b/lisp/startup.el index 3483e15842..8ab50efa87 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1157,7 +1157,7 @@ regardless of the value of this variable." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar fancy-startup-text - '((:face (variable-pitch :foreground "red") + '((:face (variable-pitch (:foreground "red")) "Welcome to " :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) @@ -1203,7 +1203,7 @@ regardless of the value of this variable." "\tView the Emacs manual using Info\n" :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) "\tGNU Emacs comes with " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch :link ("Copying Conditions" (lambda (button) (describe-copying))) @@ -1216,7 +1216,7 @@ Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") (defvar fancy-about-text - '((:face (variable-pitch :foreground "red") + '((:face (variable-pitch (:foreground "red")) "This is " :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) @@ -1232,13 +1232,14 @@ Each element in the list should be a list of strings or pairs "Display info on the GNU project."))) " operating system.\n" :face (lambda () - (list 'variable-pitch :foreground - (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue"))) + (list 'variable-pitch + (list :foreground + (if (eq (frame-parameter nil 'background-mode) 'dark) + "cyan" "darkblue")))) "\n" (lambda () (emacs-version)) "\n" - :face (variable-pitch :height 0.5) + :face (variable-pitch (:height 0.5)) (lambda () emacs-copyright) "\n\n" :face variable-pitch @@ -1257,7 +1258,7 @@ Each element in the list should be a list of strings or pairs "\tWhy we developed GNU Emacs, and the GNU operating system\n" :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) "\tGNU Emacs comes with " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch :link ("Copying Conditions" (lambda (button) (describe-copying))) @@ -1411,11 +1412,11 @@ a face or button specification." (lambda (button) (customize-group 'initialization)) "Change initialization settings including this screen") "\n")) - (fancy-splash-insert :face `(variable-pitch :foreground ,fg) + (fancy-splash-insert :face `(variable-pitch (:foreground ,fg)) "\nThis is " (emacs-version) "\n" - :face '(variable-pitch :height 0.5) + :face '(variable-pitch (:height 0.5)) emacs-copyright "\n") (and auto-save-list-file-prefix @@ -1431,12 +1432,12 @@ a face or button specification." (regexp-quote (file-name-nondirectory auto-save-list-file-prefix))) t) - (fancy-splash-insert :face '(variable-pitch :foreground "red") + (fancy-splash-insert :face '(variable-pitch (:foreground "red")) "\nIf an Emacs session crashed recently, " "type " :face '(fixed-pitch :foreground "red") "Meta-x recover-session RET" - :face '(variable-pitch :foreground "red") + :face '(variable-pitch (:foreground "red")) "\nto recover" " the files you were editing.")) @@ -1471,7 +1472,7 @@ a face or button specification." (overlay-put button 'checked t) (overlay-put button 'display (overlay-get button :on-glyph)) (setq startup-screen-inhibit-startup-screen t))))) - (fancy-splash-insert :face '(variable-pitch :height 0.9) + (fancy-splash-insert :face '(variable-pitch (:height 0.9)) " Never show it again."))))) (defun exit-splash-screen () diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0e3f9dffad..65153c3bb5 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -336,12 +336,17 @@ Always stores Fcc copy of message when nil." :group 'ispell) -(defcustom ispell-grep-command "egrep" +(defcustom ispell-grep-command + ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they + ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options + ;; below). + (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep") "Name of the grep command for search processes." :type 'string :group 'ispell) -(defcustom ispell-grep-options "-i" +(defcustom ispell-grep-options + (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i") "String of options to use when running the program in `ispell-grep-command'. Should probably be \"-i\" or \"-e\". Some machines (like the NeXT) don't support \"-i\"" diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 395145fd53..5728497ed6 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -93,6 +93,10 @@ When it reaches that size (in bytes), a warning is sent." :type 'integer :group 'thumbs) +;; Unfortunately Windows XP has a program called CONVERT.EXE in +;; C:/WINDOWS/SYSTEM32/ for partioning NTFS system. So Emacs +;; can find the one in your ImageMagick directory, you need to +;; customize this value to the absolute filename. (defcustom thumbs-conversion-program (if (eq system-type 'windows-nt) "convert.exe" diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index 01599c91df..8a1c56490a 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -522,7 +522,7 @@ Optional argument LOCALP is always ignored." (setq at-start nil) (cond ((looking-at "^added") - (setq current-vc-state 'edited) + (setq current-vc-state 'added) (setq current-bzr-state 'added)) ((looking-at "^kind changed") (setq current-vc-state 'edited) diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index c3aff66588..321f4e5280 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -947,6 +947,7 @@ is non-nil." (cond ;; entry for a "locally added" file (not yet committed) ((looking-at "/[^/]+/0/") + (vc-file-setprop file 'vc-backend 'CVS) (vc-file-setprop file 'vc-checkout-time 0) (vc-file-setprop file 'vc-working-revision "0") (if set-state (vc-file-setprop file 'vc-state 'edited))) @@ -962,6 +963,7 @@ is non-nil." ;; sticky tag "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) "\\(.*\\)")) ;Sticky tag + (vc-file-setprop file 'vc-backend 'CVS) (vc-file-setprop file 'vc-working-revision (match-string 1)) (vc-file-setprop file 'vc-cvs-sticky-tag (vc-cvs-parse-sticky-tag (match-string 4) diff --git a/lisp/vc-git.el b/lisp/vc-git.el index 7895251be0..64bcbeb0b2 100644 --- a/lisp/vc-git.el +++ b/lisp/vc-git.el @@ -155,7 +155,6 @@ "Git-specific version of `dir-state'." ;; FIXME: This can't set 'ignored yet (with-temp-buffer - (buffer-disable-undo) ;; Because these buffers can get huge (vc-git-command (current-buffer) nil nil "ls-files" "-t" "-c" "-m" "-o") (goto-char (point-min)) (let ((status-char nil) @@ -168,19 +167,24 @@ (line-end-position)))) (cond ;; The rest of the possible states in "git ls-files -t" output: - ;; R removed/deleted ;; K to be killed ;; should not show up in vc-dired, so don't deal with them ;; here. ((eq status-char ?H) + (vc-file-setprop file 'vc-backend 'Git) (vc-file-setprop file 'vc-state 'up-to-date)) + ((eq status-char ?R) + (vc-file-setprop file 'vc-backend 'Git) + (vc-file-setprop file 'vc-state 'removed)) ((eq status-char ?M) + (vc-file-setprop file 'vc-backend 'Git) (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ?C) + (vc-file-setprop file 'vc-backend 'Git) (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ??) (vc-file-setprop file 'vc-backend 'none) - (vc-file-setprop file 'vc-state 'nil))) + (vc-file-setprop file 'vc-state nil))) (forward-line))))) (defun vc-git-working-revision (file) diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index 41cc883c0a..dd8cccb724 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -194,21 +194,35 @@ (buffer-substring-no-properties (+ (point) 2) (line-end-position)))) (cond + ;; State flag for a clean file is now C, might change to =. ;; The rest of the possible states in "hg status" output: - ;; R = removed ;; ! = deleted, but still tracked ;; should not show up in vc-dired, so don't deal with them ;; here. + ((eq status-char ?C) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'up-to-date)) ((eq status-char ?A) + (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-working-revision "0") - (vc-file-setprop file 'vc-state 'edited)) + (vc-file-setprop file 'vc-state 'added)) + ((eq status-char ?R) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'removed)) ((eq status-char ?M) + (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ?I) + (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-state 'ignored)) ((eq status-char ??) (vc-file-setprop file 'vc-backend 'none) - (vc-file-setprop file 'vc-state 'unregistered))) + (vc-file-setprop file 'vc-state 'unregistered)) + ((eq status-char ?!) + nil) + (t ;; Presently C, might change to = in 0.9.6 + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'up-to-date))) (forward-line))))) (defun vc-hg-working-revision (file) diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 3d589e117c..39550da801 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -503,14 +503,16 @@ For registered files, the value returned is one of: Often represented by vc-working-revision = \"0\" in VCSes with monotonic IDs like Subversion and Mercurial. - 'ignored The file showed up in a dir-state listing with a flag + 'removed Scheduled to be deleted from the repository on next commit. + + 'ignored The file showed up in a dir-state listing with a flag indicating the version-control system is ignoring it, Note: This property is not set reliably (some VCSes don't have useful directory-status commands) so assume that any file with vc-state nil might be ignorable without VC knowing it. - 'unregistered The file showed up in a dir-state listing with a flag + 'unregistered The file showed up in a dir-state listing with a flag indicating that it is not under version control. Note: This property is not set reliably (some VCSes don't have useful directory-status commands) so assume diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index ced4c941b5..385260b3d8 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -366,6 +366,30 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (error "Couldn't analyze svn update result"))) (message "Merging changes into %s...done" file)))) +(defun vc-svn-modify-change-comment (files rev comment) + "Modify the change comments for a specified REV. +You must have ssh access to the repository host, and the directory Emacs +uses locally for temp files must also be writeable by you on that host." + (vc-do-command nil 0 "svn" nil "info") + (set-buffer "*vc*") + (goto-char (point-min)) + (unless (re-search-forward "Repository Root: svn\\+ssh://\\([^/]+\\)\\(/.*\\)" nil t) + (error "Repository information is unavailable.")) + (let* ((tempfile (make-temp-file user-mail-address)) + (host (match-string 1)) + (directory (match-string 2)) + (remotefile (concat host ":" tempfile))) + (with-temp-buffer + (insert comment) + (write-region (point-min) (point-max) tempfile)) + (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile) + (error "Copy of comment to %s failed" remotefile)) + (unless (vc-do-command nil 0 "ssh" nil + "-q" host + (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s" + directory rev tempfile tempfile)) + (error "Log edit failed")) + )) ;;; ;;; History functions @@ -543,15 +567,16 @@ information about FILENAME and return its status." (let (file status) (goto-char (point-min)) (while (re-search-forward - ;; Ignore the files with status in [IX?]. - "^[ ACDGMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t) + ;; Ignore the files with status X. + "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) ;; If the username contains spaces, the output format is ambiguous, ;; so don't trust the output's filename unless we have to. (setq file (or filename (expand-file-name (buffer-substring (point) (line-end-position))))) (setq status (char-after (line-beginning-position))) - (unless (eq status ??) + (if (eq status ??) + (vc-file-setprop file 'vc-state 'unregistered) ;; `vc-BACKEND-registered' must not set vc-backend, ;; which is instead set in vc-registered. (unless filename (vc-file-setprop file 'vc-backend 'SVN)) @@ -573,15 +598,15 @@ information about FILENAME and return its status." ;; If the file was actually copied, (match-string 2) is "-". (vc-file-setprop file 'vc-working-revision "0") (vc-file-setprop file 'vc-checkout-time 0) - 'edited) + 'added) ((memq status '(?M ?C)) (if (eq (char-after (match-beginning 1)) ?*) 'needs-merge 'edited)) ((eq status ?I) (vc-file-setprop file 'vc-state 'ignored)) - ((eq status ??) - (vc-file-setprop file 'vc-state 'unregistered)) + ((eq status ?R) + (vc-file-setprop file 'vc-state 'removed)) (t 'edited))))) (if filename (vc-file-getprop filename 'vc-state)))) diff --git a/lisp/vc.el b/lisp/vc.el index 5ec872523b..ddcb53a0cb 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -159,11 +159,13 @@ ;; ;; - dir-state (dir) ;; -;; If provided, this function is used to find the version control state -;; of all files in DIR, and all subdirecties of DIR, in a fast way. -;; The function should not return anything, but rather store the files' -;; states into the corresponding `vc-state' properties. (Note: in -;; older versions this method was not required to recurse into +;; If provided, this function is used to find the version control +;; state of as many files as possible in DIR, and all subdirecties +;; of DIR, in a fast way; it is used to avoid expensive indivitual +;; vc-state calls. The function should not return anything, but +;; rather store the files' states into the corresponding properties. +;; Two properties are required: `vc-backend' and `vc-state'. (Note: +;; in older versions this method was not required to recurse into ;; subdirectories.) ;; ;; * working-revision (file) @@ -1346,6 +1348,12 @@ NOT-URGENT means it is ok to continue if the user says not to save." (defvar vc-dired-window-configuration) +(defun vc-compatible-state (p q) + "Controls which states can be in the same commit." + (or + (eq p q) + (and (member p '(edited added removed)) (member q '(edited added removed))))) + ;; Here's the major entry point. ;;;###autoload @@ -1386,7 +1394,7 @@ merge in the changes into your working copy." revision) ;; Verify that the fileset is homogenous (dolist (file (cdr files)) - (if (not (eq (vc-state file) state)) + (if (not (vc-compatible-state (vc-state file) state)) (error "Fileset is in a mixed-up state")) (if (not (eq (vc-checkout-model file) model)) (error "Fileset has mixed checkout models"))) @@ -1436,7 +1444,7 @@ merge in the changes into your working copy." ;; do nothing (message "Fileset is up-to-date")))) ;; Files have local changes - ((eq state 'edited) + ((vc-compatible-state state 'edited) (let ((ready-for-commit files)) ;; If files are edited but read-only, give user a chance to correct (dolist (file files) @@ -2349,7 +2357,9 @@ Called by dired after any portion of a vc-dired buffer has been read in." (if (and (vc-call-backend backend 'responsible-p default-directory) (vc-find-backend-function backend 'dir-state)) (vc-call-backend backend 'dir-state default-directory))) - (let (filename (inhibit-read-only t)) + (let (filename + (inhibit-read-only t) + (buffer-undo-list t)) (goto-char (point-min)) (while (not (eobp)) (cond @@ -2383,27 +2393,25 @@ Called by dired after any portion of a vc-dired buffer has been read in." (t (vc-dired-reformat-line nil) (forward-line 1)))) - ;; try to head off calling the expensive state query - + ;; Try to head off calling the expensive state query - ;; ignore object files, TeX intermediate files, and so forth. ((vc-dired-ignorable-p filename) (dired-kill-line)) - ;; ordinary file -- call the (possibly expensive) state query - (t - (let ((backend (vc-backend filename))) - (cond - ;; Not registered - ((not backend) - (if vc-dired-terse-mode - (dired-kill-line) - (vc-dired-reformat-line "?") - (forward-line 1))) - ;; Either we're in non-terse mode or it's out of date - ((not (and vc-dired-terse-mode (vc-up-to-date-p filename))) - (vc-dired-reformat-line (vc-call dired-state-info filename)) - (forward-line 1)) - ;; Remaining cases are under version control but uninteresting - (t - (dired-kill-line))))))) + ;; Ordinary file -- call the (possibly expensive) state query + ;; + ;; First case: unregistered or unknown. (Unknown shouldn't happen here) + ((member (vc-state filename) '(nil unregistered)) + (if vc-dired-terse-mode + (dired-kill-line) + (vc-dired-reformat-line "?") + (forward-line 1))) + ;; Either we're in non-terse mode or it's out of date + ((not (and vc-dired-terse-mode (vc-up-to-date-p filename))) + (vc-dired-reformat-line (vc-call dired-state-info filename)) + (forward-line 1)) + ;; Remaining cases are under version control but uninteresting + (t + (dired-kill-line)))) ;; any other line (t (forward-line 1)))) (vc-dired-purge)) @@ -3076,6 +3084,7 @@ to provide the `find-revision' operation instead." ((eq state 'needs-merge) "(merge)") ((eq state 'needs-patch) "(patch)") ((eq state 'added) "(added)") + ((eq state 'removed) "(removed)") ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out ((eq state 'unregistered) "?") ((eq state 'unlocked-changes) "(stale)") |