procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Trailing whitepace deleted.

Browse source
This commit is contained in:
Juanma Barranquero 2003-02-04 13:24:35 +00:00
parent f1180544bb
commit a1506d2977
271 changed files with 3408 additions and 3408 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/calc/README
View file

@ -11,7 +11,7 @@ Written by:
San Jose CA 95134
daveg@synaptics.com, uunet!synaptx!daveg
Currently maintained by:
Currently maintained by:
D. Goel <deego@gnufans.org> and Colin Walters <walters@debian.org>
From the introduction to the manual:

2
lisp/calc/README.prev
View file

@ -384,7 +384,7 @@ Version 2.00 alpha 1:
* Redesigned user interface of `a F' (calc-curve-fit) command.
* Added "phase" feature to the rewrite rule system.
* Added "phase" feature to the rewrite rule system.
* Added "&&&", "|||", "!!!" to the rewrite rule system.

2
lisp/calc/calc-aent.el
View file

@ -432,7 +432,7 @@
(defun calc-alg-digit-entry ()
(calc-alg-entry
(calc-alg-entry
(cond ((eq last-command-char ?e)
(if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
((eq last-command-char ?#) (format "%d#" calc-number-radix))

8
lisp/calc/calc-alg.el
View file

@ -1,9 +1,9 @@
;;; calc-alg.el --- algebraic functions for Calc
;;; calc-alg.el --- algebraic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -70,7 +70,7 @@
(calc-with-default-simplification
(let ((math-simplify-only nil))
(calc-modify-simplify-mode arg)
(calc-enter-result 1 "expf"
(calc-enter-result 1 "expf"
(if (> arg 0)
(let ((math-expand-formulas t))
(calc-top-n 1))
@ -1257,7 +1257,7 @@
(if (Math-objvecp expr)
(and (eq always 1)
(list expr 1))
(and always
(and always
(list 1 expr)))))
(defun calcFunc-lin (expr &optional var)

4
lisp/calc/calc-arith.el
View file

@ -1,9 +1,9 @@
;;; calc-arith.el --- arithmetic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-bin.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

4
lisp/calc/calc-comb.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -326,7 +326,7 @@
(math-div
(math-pow -2 (- tn))
(math-double-factorial-iter (* -2 tn) 3 1 2))
(math-div
(math-div
(math-double-factorial-iter (* 2 tn) 3 1 2)
(math-pow 2 tn)))))
(math-mul q (if calc-symbolic-mode

2
lisp/calc/calc-cplx.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-embed.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

24
lisp/calc/calc-ext.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -660,7 +660,7 @@
(define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
(define-key calc-alg-map "\e\177" 'calc-pop-above)
))
;; The following is a relic for backward compatability only.
;; The calc-define property list is now the recommended method.
(if (and (boundp 'calc-ext-defs)
@ -1631,9 +1631,9 @@ calc-kill calc-kill-region calc-yank))))
( * ( * ) ( * ) )
( / ( / ) ( ) )
( | ( | ) ( | ) )
( calcFunc-land ( calcFunc-land )
( calcFunc-land ( calcFunc-land )
( calcFunc-land ) )
( calcFunc-lor ( calcFunc-lor )
( calcFunc-lor ( calcFunc-lor )
( calcFunc-lor ) ) ))
@ -2725,7 +2725,7 @@ calc-kill calc-kill-region calc-yank))))
(math-integerp int) (math-integerp num) (math-integerp den)
(not (math-zerop den))
(list 'frac (math-add num (math-mul int den)) den)))))
;; Fractions
((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
(let ((num (math-match-substring s 1))
@ -2735,7 +2735,7 @@ calc-kill calc-kill-region calc-yank))))
(and num den (math-integerp num) (math-integerp den)
(not (math-zerop den))
(list 'frac num den)))))
;; Modulo forms
((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
(let* ((n (math-match-substring s 1))
@ -2771,7 +2771,7 @@ calc-kill calc-kill-region calc-yank))))
(math-zerop (nth 1 minsec)))
(math-add (list 'hms hours 0 0) minsec))
(t nil)))))
;; Minutes
((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
(let* ((minutes (math-match-substring s 1))
@ -2789,7 +2789,7 @@ calc-kill calc-kill-region calc-yank))))
(math-zerop (nth 2 seconds)))
(math-add (list 'hms 0 minutes 0) seconds))
(t nil)))))
;; Seconds
((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
(let ((seconds (math-read-number (math-match-substring s 1))))
@ -2797,7 +2797,7 @@ calc-kill calc-kill-region calc-yank))))
(not (math-negp seconds))
(Math-lessp seconds 60)
(list 'hms 0 0 seconds))))
;; Integer+fraction with explicit radix
((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
(let ((radix (string-to-int (math-match-substring s 1)))
@ -2811,7 +2811,7 @@ calc-kill calc-kill-region calc-yank))))
(list 'frac
(math-add num (math-mul int den))
den)))))
;; Fraction with explicit radix
((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
(let ((radix (string-to-int (math-match-substring s 1)))
@ -2820,11 +2820,11 @@ calc-kill calc-kill-region calc-yank))))
(let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
(den (if (> (length den) 0) (math-read-radix den radix) 1)))
(and num den (not (math-zerop den)) (list 'frac num den)))))
;; Float with explicit radix and exponent
((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s)
(string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s))
(let ((radix (string-to-int (math-match-substring s 2)))
(let ((radix (string-to-int (math-match-substring s 2)))
(mant (math-match-substring s 1))
(exp (math-match-substring s 4)))
(let ((mant (math-read-number mant))

2
lisp/calc/calc-fin.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-forms.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-frac.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-funcs.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

4
lisp/calc/calc-graph.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -1399,7 +1399,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(and calc-gnuplot-geometry
(list "-geometry"
calc-gnuplot-geometry)))))
(setq calc-gnuplot-process
(setq calc-gnuplot-process
(apply 'start-process
"gnuplot"
calc-gnuplot-buffer

2
lisp/calc/calc-help.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-incom.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-keypd.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

4
lisp/calc/calc-lang.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -253,7 +253,7 @@
( conjg . calcFunc-conj )
( log . calcFunc-ln )
( nint . calcFunc-round )
( real . calcFunc-re )))
( real . calcFunc-re )))
(put 'fortran 'math-input-filter 'calc-input-case-filter)
(put 'fortran 'math-output-filter 'calc-output-case-filter)

2
lisp/calc/calc-macs.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-maint.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-map.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-math.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-misc.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

4
lisp/calc/calc-mode.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -459,7 +459,7 @@
(defun calc-symbolic-mode (n)
(interactive "P")
(calc-wrapper
(message (if (calc-change-mode 'calc-symbolic-mode n nil t)
"Inexact computations like sqrt(2) are deferred"
"Numerical computations are always done immediately"))))

2
lisp/calc/calc-mtx.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-poly.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

4
lisp/calc/calc-prog.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -930,7 +930,7 @@
(def (or (assq key (calc-user-key-map))
(assq (upcase key) (calc-user-key-map))
(assq (downcase key) (calc-user-key-map))
(and (eq key ?\')
(and (eq key ?\')
(cons nil
(intern (completing-read
(format "Record in %s the function: "

46
lisp/calc/calc-rewr.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -1442,14 +1442,14 @@
btrack nil)
(aset regs 0 expr)
(while pc
(and tracing
(progn (terpri) (princ (car pc))
(if (and (natnump (nth 1 (car pc)))
(< (nth 1 (car pc)) (length regs)))
(princ (format "\n part = %s"
(aref regs (nth 1 (car pc))))))))
(cond ((eq (setq op (car (setq inst (car pc)))) 'func)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(eq (car part)
@ -1462,14 +1462,14 @@
(not (or inst part))))
(setq pc (cdr pc))
(math-rwfail)))
((eq op 'same)
(if (or (equal (setq part (aref regs (nth 1 inst)))
(setq mark (aref regs (nth 2 inst))))
(Math-equal part mark))
(setq pc (cdr pc))
(math-rwfail)))
((and (eq op 'try)
calc-matrix-mode
(not (eq calc-matrix-mode 'scalar))
@ -1487,7 +1487,7 @@
(aset mark 1 (cdr part)))
(aset mark 0 (cdr part))
(aset mark 2 0))
((eq op 'try)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(memq (car part) (nth 2 inst))
@ -1545,7 +1545,7 @@
(aset regs (nth 4 inst) part)
(aset mark 2 3))
(math-rwfail))))
((eq op 'try2)
(setq part (nth 1 inst) ; try instr
mark (nth 3 part)
@ -1588,7 +1588,7 @@
(car (aref mark 1)))
((eq op 3) (nth 5 part))
(t (aref mark 1)))))
((eq op 'select)
(setq pc (cdr pc))
(if (and (consp (setq part (aref regs (nth 1 inst))))
@ -1597,7 +1597,7 @@
(if math-rewrite-selections
(math-rwfail)
(aset regs (nth 2 inst) part))))
((eq op 'same-neg)
(if (or (equal (setq part (aref regs (nth 1 inst)))
(setq mark (math-neg
@ -1605,7 +1605,7 @@
(Math-equal part mark))
(setq pc (cdr pc))
(math-rwfail)))
((eq op 'backtrack)
(setq inst (car (car btrack)) ; "try" or "alt" instr
pc (cdr (car btrack))
@ -1676,7 +1676,7 @@
((eq op 4)
(setq btrack (cdr btrack)))
(t (math-rwfail t))))
((eq op 'integer)
(if (Math-integerp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
@ -1686,7 +1686,7 @@
(if (Math-integerp part)
(setq pc (cdr pc))
(math-rwfail)))))
((eq op 'real)
(if (Math-realp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
@ -1696,7 +1696,7 @@
(if (Math-realp part)
(setq pc (cdr pc))
(math-rwfail)))))
((eq op 'constant)
(if (math-constp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
@ -1706,7 +1706,7 @@
(if (math-constp part)
(setq pc (cdr pc))
(math-rwfail)))))
((eq op 'negative)
(if (math-looks-negp (setq part (aref regs (nth 1 inst))))
(setq pc (cdr pc))
@ -1716,7 +1716,7 @@
(if (math-looks-negp part)
(setq pc (cdr pc))
(math-rwfail)))))
((eq op 'rel)
(setq part (math-compare (aref regs (nth 1 inst))
(aref regs (nth 3 inst)))
@ -1741,7 +1741,7 @@
(memq part '(0 1))))
(setq pc (cdr pc))
(math-rwfail)))
((eq op 'func-def)
(if (and (consp (setq part (aref regs (car (cdr inst)))))
(eq (car part)
@ -1831,33 +1831,33 @@
(math-rwapply-replace-regs (nth 1 inst)))))
(setq pc (cdr pc))
(math-rwfail)))
((eq op 'let)
(aset regs (nth 1 inst)
(math-rweval
(math-normalize
(math-rwapply-replace-regs (nth 2 inst)))))
(setq pc (cdr pc)))
((eq op 'copy)
(aset regs (nth 2 inst) (aref regs (nth 1 inst)))
(setq pc (cdr pc)))
((eq op 'copy-neg)
(aset regs (nth 2 inst)
(math-rwapply-neg (aref regs (nth 1 inst))))
(setq pc (cdr pc)))
((eq op 'alt)
(setq btrack (cons pc btrack)
pc (nth 1 inst)))
((eq op 'end-alt)
(while (and btrack (not (eq (car btrack) (nth 1 inst))))
(setq btrack (cdr btrack)))
(setq btrack (cdr btrack)
pc (cdr pc)))
((eq op 'done)
(setq result (math-rwapply-replace-regs (nth 1 inst)))
(if (or (and (eq (car-safe result) '+)
@ -1877,7 +1877,7 @@
(if part (math-rwapply-remember expr result))
(setq rules nil))
(setq pc nil))
(t (error "%s is not a valid rewrite opcode" op))))))
(setq rules (cdr rules)))
result)))

2
lisp/calc/calc-rules.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

6
lisp/calc/calc-sel.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -50,7 +50,7 @@
(if once (progn
(setq calc-keep-selection nil)
(message "(Selection will apply to next command only)")))
(calc-change-current-selection
(calc-change-current-selection
(if found
(if (and num (> (setq num (prefix-numeric-value num)) 0))
(progn
@ -113,7 +113,7 @@
(calc-prepare-selection)
(let ((found (calc-find-selected-part))
(entry calc-selection-cache-entry))
(calc-change-current-selection
(calc-change-current-selection
(and found
(let ((sel (nth 2 entry))
old index op)

2
lisp/calc/calc-stat.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-store.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

4
lisp/calc/calc-stuff.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -209,7 +209,7 @@ With a prefix, push that prefix as a number onto the stack."
(defun calc-clean-num (num)
(interactive "P")
(calc-clean (- (if num
(prefix-numeric-value num)
(prefix-numeric-value num)
(if (and (>= last-command-char ?0)
(<= last-command-char ?9))
(- last-command-char ?0)

2
lisp/calc/calc-trail.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calc-undo.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

12
lisp/calc/calc-units.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -63,12 +63,12 @@
( tpt "in/72.27" "Point (TeX conventions)" )
( Ang "1e-10 m" "Angstrom" )
( mfi "mi+ft+in" "Miles + feet + inches" )
;; Area
( hect "10000 m^2" "*Hectare" )
( acre "mi^2 / 640" "Acre" )
( b "1e-28 m^2" "Barn" )
;; Volume
( l "1e-3 m^3" "*Liter" )
( L "1e-3 m^3" "Liter" )
@ -83,7 +83,7 @@
( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" )
( galC "4.54609 l" "Canadian Gallon" )
( galUK "4.546092 l" "UK Gallon" )
;; Time
( s nil "*Second" )
( sec "s" "Second" )
@ -99,8 +99,8 @@
( mph "mi/hr" "*Miles per hour" )
( kph "km/hr" "Kilometers per hour" )
( knot "nmi/hr" "Knot" )
( c "2.99792458e8 m/s" "Speed of light" )
( c "2.99792458e8 m/s" "Speed of light" )
;; Acceleration
( ga "9.80665 m/s^2" "*\"g\" acceleration" )

2
lisp/calc/calc-vec.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

6
lisp/calc/calc-yank.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -131,7 +131,7 @@
(defun calc-clean-newlines (s)
(cond
;; Omit leading/trailing whitespace
((or (string-match "\\`[ \n\r]+\\([^\001]*\\)\\'" s)
(string-match "\\`\\([^\001]*\\)[ \n\r]+\\'" s))
@ -141,7 +141,7 @@
((string-match "\\`\\(.*\\)[\n\r]+\\([^\001]*\\)\\'" s)
(calc-clean-newlines (concat (math-match-substring s 1) ","
(math-match-substring s 2))))
(t s)))

48
lisp/calc/calc.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; Keywords: convenience, extensions
;; Version: 2.02g
@ -146,57 +146,57 @@
;; Subject: Re: fix for `Cannot open load file: calc-alg-3'
;; To: walters@debian.org
;; Date: Sat, 24 Nov 2001 21:44:21 +0000 (UTC)
;;
;;
;; Could you add logistic curve fitting to the current list?
;;
;;
;; (I guess the key binding for a logistic curve would have to be `s'
;; since a logistic curve is an `s' curve; both `l' and `L' are already
;; taken for logarithms.)
;;
;;
;; Here is the current list for curve fitting;
;;
;;
;; `1'
;; Linear or multilinear. a + b x + c y + d z.
;;
;;
;; `2-9'
;; Polynomials. a + b x + c x^2 + d x^3.
;;
;;
;; `e'
;; Exponential. a exp(b x) exp(c y).
;;
;;
;; `E'
;; Base-10 exponential. a 10^(b x) 10^(c y).
;;
;;
;; `x'
;; Exponential (alternate notation). exp(a + b x + c y).
;;
;;
;; `X'
;; Base-10 exponential (alternate). 10^(a + b x + c y).
;;
;;
;; `l'
;; Logarithmic. a + b ln(x) + c ln(y).
;;
;;
;; `L'
;; Base-10 logarithmic. a + b log10(x) + c log10(y).
;;
;;
;; `^'
;; General exponential. a b^x c^y.
;;
;;
;; `p'
;; Power law. a x^b y^c.
;;
;;
;; `q'
;; Quadratic. a + b (x-c)^2 + d (x-e)^2.
;;
;;
;; `g'
;; Gaussian. (a / b sqrt(2 pi)) exp(-0.5*((x-c)/b)^2).
;;
;;
;;
;;
;; Logistic curves are used a great deal in ecology, and in predicting
;; human actions, such as use of different kinds of energy in a country
;; (wood, coal, oil, natural gas, etc.) or the number of scientific
;; papers a person publishes, or the number of movies made.
;;
;;
;; (The less information on which to base the curve, the higher the error
;; rate. Theodore Modis ran some Monte Carlo simulations and produced
;; what may be useful set of confidence levels for different amounts of
@ -645,17 +645,17 @@ scientific notation in calc-mode.")
;; The following modes use specially-formatted data.
(put 'calc-mode 'mode-class 'special)
(put 'calc-trail-mode 'mode-class 'special)
;; Define "inexact-result" as an e-lisp error symbol.
(put 'inexact-result 'error-conditions '(error inexact-result calc-error))
(put 'inexact-result 'error-message "Calc internal error (inexact-result)")
;; Define "math-overflow" and "math-underflow" as e-lisp error symbols.
(put 'math-overflow 'error-conditions '(error math-overflow calc-error))
(put 'math-overflow 'error-message "Floating-point overflow occurred")
(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
(put 'math-underflow 'error-message "Floating-point underflow occurred")
(defconst calc-version "2.02g")
(defconst calc-version-date "Mon Nov 19 2001")
(defvar calc-trail-pointer nil) ; "Current" entry in trail buffer.
@ -848,7 +848,7 @@ scientific notation in calc-mode.")
math-find-user-tokens math-read-expr-list math-read-exprs math-read-if
math-read-token math-remove-dashes)
("calc-misc" calc-Need-calc-misc
("calc-misc" calc-Need-calc-misc
calc-do-handle-whys calc-do-refresh calc-num-prefix-name
calc-record-list calc-record-why calc-report-bug calc-roll-down-stack
calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor
@ -3364,7 +3364,7 @@ Also looks for the equivalent TeX words, \\gets and \\evalto."
(push (or input last-command-event) unread-command-events)))
(defun calc-clear-unread-commands ()
(if (featurep 'xemacs)
(if (featurep 'xemacs)
(calc-emacs-type-lucid (setq unread-command-event nil))
(setq unread-command-events nil)))

8
lisp/calc/calcalg2.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -1292,7 +1292,7 @@
(unwind-protect
(let ((p math-integral-cache)
cur-record)
(display-buffer (get-buffer-create "*Integral Cache*"))
(display-buffer (get-buffer-create "*Integral Cache*"))
(set-buffer (get-buffer "*Integral Cache*"))
(erase-buffer)
(while p
@ -2116,7 +2116,7 @@
(setq t2 (math-simplify
(math-sub (car t1)
(math-mul high 2)))
t3 (math-simplify
t3 (math-simplify
(math-sub (car t1)
(math-mul low
2))))))
@ -3095,7 +3095,7 @@
(mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
(mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
(math-normalize
(cons 'vec
(cons 'vec
(if solns
(mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
(mapcar 'car eqn-list)))))))

4
lisp/calc/calcalg3.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -1314,7 +1314,7 @@
;;; Open Romberg method; "qromo" in section 4.4.
(defun math-ninteg-romberg (func expr lo hi mode)
(defun math-ninteg-romberg (func expr lo hi mode)
(let ((curh '(float 1 0))
(h nil)
(s nil)

2
lisp/calc/calccomp.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

2
lisp/calc/calcsel2.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Maintainers: D. Goel <deego@gnufans.org>
;; Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.

90
lisp/calendar/appt.el
View file

@ -34,36 +34,36 @@
;;; And to many others for bug fixes and suggestions.
;;;
;;;
;;; This functions in this file will alert the user of a
;;; This functions in this file will alert the user of a
;;; pending appointment based on their diary file.
;;;
;;; A message will be displayed in the mode line of the Emacs buffer
;;; and (if you request) the terminal will beep and display a message
;;; from the diary in the mini-buffer, or you can choose to
;;; from the diary in the mini-buffer, or you can choose to
;;; have a message displayed in a new buffer.
;;;
;;; The variable `appt-message-warning-time' allows the
;;; user to specify how much notice they want before the appointment. The
;;; user to specify how much notice they want before the appointment. The
;;; variable `appt-issue-message' specifies whether the user wants
;;; to be notified of a pending appointment.
;;;
;;;
;;; In order to use the appt package, you only need
;;; to load it---provided you have appointments.
;;;
;;; Before that, you can also set some options if you want
;;; (setq view-diary-entries-initially t)
;;; (setq appt-issue-message t)
;;;
;;;
;;; This is an example of what can be in your diary file:
;;; Monday
;;; 9:30am Coffee break
;;; 12:00pm Lunch
;;;
;;; Based upon the above lines in your .emacs and diary files,
;;; 12:00pm Lunch
;;;
;;; Based upon the above lines in your .emacs and diary files,
;;; the calendar and diary will be displayed when you enter
;;; Emacs and your appointments list will automatically be created.
;;; You will then be reminded at 9:20am about your coffee break
;;; and at 11:50am to go to lunch.
;;; and at 11:50am to go to lunch.
;;;
;;; Use describe-function on appt-check for a description of other variables
;;; that can be used to personalize the notification system.
@ -146,7 +146,7 @@ as the first thing on a line."
;;;###autoload
(defcustom appt-display-diary t
"*Non-nil means to display the next days diary on the screen.
"*Non-nil means to display the next days diary on the screen.
This will occur at midnight when the appointment list is updated."
:type 'boolean
:group 'appt)
@ -164,13 +164,13 @@ The number before each time/message is the time in minutes from midnight.")
"*Number of minutes to wait between checking the appointment list."
:type 'integer
:group 'appt)
(defvar appt-buffer-name " *appt-buf*"
"Name of the appointments buffer.")
(defvar appt-disp-window-function 'appt-disp-window
"Function called to display appointment window.")
(defvar appt-delete-window-function 'appt-delete-window
"Function called to remove appointment window and buffer.")
@ -192,11 +192,11 @@ Note: the time must be the first thing in the line in the diary
for a warning to be issued.
The format of the time can be either 24 hour or am/pm.
Example:
Example:
02/23/89
18:00 Dinner
Thursday
11:45am Lunch meeting.
@ -231,7 +231,7 @@ The following variables control appointment notification:
Function called to display appointment window. You can customize
appt.el by setting this variable to a function different from the
one provided with this package.
`appt-delete-window-function'
Function called to remove appointment window and buffer. You can
customize appt.el by setting this variable to a function different
@ -264,7 +264,7 @@ The following variables control appointment notification:
(cur-min (nth 1 now))
(cur-comp-time (+ (* cur-hour 60) cur-min)))
;; At the first check in any given day, update our
;; At the first check in any given day, update our
;; appointments to today's list.
(if (or (null appt-prev-comp-time)
@ -290,11 +290,11 @@ The following variables control appointment notification:
(let ((appt-comp-time (car (car (car appt-time-msg-list)))))
(setq min-to-app (- appt-comp-time cur-comp-time))
(while (and appt-time-msg-list
(while (and appt-time-msg-list
(< appt-comp-time cur-comp-time))
(setq appt-time-msg-list (cdr appt-time-msg-list))
(setq appt-time-msg-list (cdr appt-time-msg-list))
(if appt-time-msg-list
(setq appt-comp-time
(setq appt-comp-time
(car (car (car appt-time-msg-list))))))
;; If we have an appointment between midnight and
@ -302,8 +302,8 @@ The following variables control appointment notification:
;; we must begin to issue a message before midnight.
;; Midnight is considered 0 minutes and 11:59pm is
;; 1439 minutes. Therefore we must recalculate the minutes
;; to appointment variable. It is equal to the number of
;; minutes before midnight plus the number of
;; to appointment variable. It is equal to the number of
;; minutes before midnight plus the number of
;; minutes after midnight our appointment is.
(if (and (< appt-comp-time appt-message-warning-time)
@ -312,7 +312,7 @@ The following variables control appointment notification:
(setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
appt-comp-time))
;; issue warning if the appointment time is
;; issue warning if the appointment time is
;; within appt-message-warning time
(when (and (<= min-to-app appt-message-warning-time)
@ -337,7 +337,7 @@ The following variables control appointment notification:
;;; else
(if appt-visible
(message "%s"
(message "%s"
(car (cdr (car appt-time-msg-list)))))
(if appt-audible
@ -379,11 +379,11 @@ The following variables control appointment notification:
;; before splitting the window.
(if (equal (selected-window) (minibuffer-window))
(if (other-window 1)
(if (other-window 1)
(select-window (other-window 1))
(if (display-multi-frame-p)
(select-frame (other-frame 1)))))
(let* ((this-buffer (current-buffer))
(this-window (selected-window))
(appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
@ -397,7 +397,7 @@ The following variables control appointment notification:
(appt-select-lowest-window)
(split-window))
(pop-to-buffer appt-disp-buf))
(setq mode-line-format
(setq mode-line-format
(concat "-------------------- Appointment in "
min-to-app " minutes. " new-time " %-"))
(erase-buffer)
@ -408,7 +408,7 @@ The following variables control appointment notification:
(select-window this-window)
(if appt-audible
(beep 1))))
(defun appt-delete-window ()
"Function called to undisplay appointment messages.
Usually just deletes the appointment buffer."
@ -440,12 +440,12 @@ The time should be in either 24 hour format or am/pm format."
(if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
nil
(error "Unacceptable time-string"))
(let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
(appt-time (list (appt-convert-time new-appt-time)))
(time-msg (cons appt-time (list appt-time-string))))
(setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
;;;###autoload
(defun appt-delete ()
@ -454,13 +454,13 @@ The time should be in either 24 hour format or am/pm format."
(let* ((tmp-msg-list appt-time-msg-list))
(while tmp-msg-list
(let* ((element (car tmp-msg-list))
(prompt-string (concat "Delete "
(prompt-string (concat "Delete "
;; We want to quote any doublequotes
;; in the string, as well as put
;; doublequotes around it.
(prin1-to-string
(substring-no-properties
(car (cdr element)) 0))
(car (cdr element)) 0))
" from list? "))
(test-input (y-or-n-p prompt-string)))
(setq tmp-msg-list (cdr tmp-msg-list))
@ -468,7 +468,7 @@ The time should be in either 24 hour format or am/pm format."
(setq appt-time-msg-list (delq element appt-time-msg-list)))))
(appt-check)
(message "")))
(eval-when-compile (defvar number)
(defvar original-date)
@ -502,7 +502,7 @@ They specify the range of dates that the diary is being processed for."
(if diary-entries-list
;; Cycle through the entry-list (diary-entries-list)
;; looking for entries beginning with a time. If
;; looking for entries beginning with a time. If
;; the entry begins with a time, add it to the
;; appt-time-msg-list. Then sort the list.
@ -514,8 +514,8 @@ They specify the range of dates that the diary is being processed for."
(car entry-list) (list (calendar-current-date))))
(setq entry-list (cdr entry-list)))
;; Parse the entries for today.
(while (and entry-list
(calendar-date-equal
(while (and entry-list
(calendar-date-equal
(calendar-current-date) (car (car entry-list))))
(let ((time-string (cadr (car entry-list))))
(while (string-match
@ -559,10 +559,10 @@ They specify the range of dates that the diary is being processed for."
(appt-comp-time (car (car (car appt-time-msg-list)))))
(while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
(setq appt-time-msg-list (cdr appt-time-msg-list))
(setq appt-time-msg-list (cdr appt-time-msg-list))
(if appt-time-msg-list
(setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
(defun appt-sort-list (appt-list)
"Simple sort to put the appointments list APPT-LIST in order.
@ -593,24 +593,24 @@ it from the original list."
(min 0))
(string-match ":\\([0-9][0-9]\\)" time2conv)
(setq min (string-to-int
(setq min (string-to-int
(match-string 1 time2conv)))
(string-match "[0-9]?[0-9]:" time2conv)
(setq hr (string-to-int
(setq hr (string-to-int
(match-string 0 time2conv)))
;; convert the time appointment time into 24 hour time
(cond ((and (string-match "pm" time2conv) (< hr 12))
(setq hr (+ 12 hr)))
((and (string-match "am" time2conv) (= hr 12))
(setq hr 0)))
;; convert the actual time
;; into minutes for comparison
;; against the actual time.
(setq conv-time (+ (* hr 60) min))
conv-time))

2
lisp/calendar/cal-china.el
View file

@ -57,7 +57,7 @@
(defvar chinese-calendar-terrestrial-branch
["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])
(defcustom chinese-calendar-time-zone
(defcustom chinese-calendar-time-zone
'(if (< year 1928)
(+ 465 (/ 40.0 60.0))
480)

2
lisp/calendar/cal-coptic.el
View file

@ -77,7 +77,7 @@ Gregorian date Sunday, December 31, 1 BC."
(/ year 4) ;; Leap days in prior years
(* 30 (1- month)) ;; Days in prior months this year
day))) ;; Days so far this month
(defun calendar-coptic-from-absolute (date)
"Compute the Coptic equivalent for absolute date DATE.

8
lisp/calendar/cal-dst.el
View file

@ -278,7 +278,7 @@ example, -300 for New York City, -480 for Los Angeles.")
(defvar calendar-daylight-time-offset
(or (car (cdr calendar-current-time-zone-cache)) 60)
"*Number of minutes difference between daylight savings and standard time.
If the locale never uses daylight savings time, set this to 0.")
(defvar calendar-standard-time-zone-name
@ -290,7 +290,7 @@ For example, \"EST\" in New York City, \"PST\" for Los Angeles.")
(or (car (nthcdr 3 calendar-current-time-zone-cache)) "EDT")
"*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
;;;###autoload
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
(defvar calendar-daylight-savings-starts
@ -331,11 +331,11 @@ For example, if daylight savings time ends on the last Sunday in October:
'(calendar-nth-named-day -1 0 10 year)
If the locale never uses daylight savings time, set this to nil.")
(defvar calendar-daylight-savings-starts-time
(or (car (nthcdr 6 calendar-current-time-zone-cache)) 120)
"*Number of minutes after midnight that daylight savings time starts.")
(defvar calendar-daylight-savings-ends-time
(or (car (nthcdr 7 calendar-current-time-zone-cache))
calendar-daylight-savings-starts-time)

38
lisp/calendar/cal-hebrew.el
View file

@ -115,9 +115,9 @@ Gregorian date Sunday, December 31, 1 BC."
day)))
(if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
(memq (% alternative-day 7) (list 0 3 5))
;; Then postpone it one (more) day and return
;; Then postpone it one (more) day and return
(1+ alternative-day)
;; Else return
;; Else return
alternative-day)))
(defun hebrew-calendar-days-in-year (year)
@ -316,7 +316,7 @@ nil if it is not visible in the current calendar window."
(list (calendar-gregorian-from-absolute (+ abs-r-h 22))
"Simchat Torah")))
(optional
(list
(list
(list (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before 6 (- abs-r-h 4)))
"Selichot (night)")
@ -350,7 +350,7 @@ nil if it is not visible in the current calendar window."
(filter-visible-calendar-holidays mandatory)))
(if all-hebrew-calendar-holidays
(setq output-list
(append
(append
(filter-visible-calendar-holidays optional)
output-list)))
output-list)))
@ -401,7 +401,7 @@ nil if it is not visible in the current calendar window."
(list (calendar-gregorian-from-absolute (+ abs-p 50))
"Shavuot")))
(optional
(list
(list
(list (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before 6 (- abs-p 43)))
"Shabbat Shekalim")
@ -467,7 +467,7 @@ nil if it is not visible in the current calendar window."
(filter-visible-calendar-holidays mandatory)))
(if all-hebrew-calendar-holidays
(setq output-list
(append
(append
(filter-visible-calendar-holidays optional)
output-list)))
output-list)))
@ -481,7 +481,7 @@ nil if it is not visible in the current calendar window."
(list 5 9 (+ displayed-year 3760)))))
(filter-visible-calendar-holidays
(list
(list
(list (calendar-gregorian-from-absolute
(if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
"Tzom Tammuz")
@ -513,7 +513,7 @@ not be marked in the calendar. This function is provided for use with the
(mark (regexp-quote diary-nonmarking-symbol)))
(calendar-for-loop i from 1 to number do
(let* ((d diary-date-forms)
(hdate (calendar-hebrew-from-absolute
(hdate (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month hdate))
(day (extract-calendar-day hdate))
@ -683,7 +683,7 @@ is provided for use as part of the nongregorian-diary-marking-hook."
(setq mm 0)
(setq
mm
(cdr
(cdr
(assoc-ignore-case
mm-name
(calendar-make-alist
@ -775,7 +775,7 @@ Prefix arg will make the entry nonmarking."
(make-diary-entry
(concat
hebrew-diary-entry-symbol
(calendar-date-string
(calendar-date-string
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))
@ -794,7 +794,7 @@ Prefix arg will make the entry nonmarking."
(make-diary-entry
(concat
hebrew-diary-entry-symbol
(calendar-date-string
(calendar-date-string
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
@ -814,7 +814,7 @@ Prefix arg will make the entry nonmarking."
(make-diary-entry
(concat
hebrew-diary-entry-symbol
(calendar-date-string
(calendar-date-string
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
@ -900,7 +900,7 @@ from the cursor position."
"Omer count diary entry.
Entry applies if date is within 50 days after Passover.
An optional parameter MARK specifies a face or single-character string to
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((passover
(calendar-absolute-from-hebrew
@ -909,7 +909,7 @@ use when highlighting the day in the calendar."
(week (/ omer 7))
(day (% omer 7)))
(if (and (> omer 0) (< omer 50))
(cons mark
(cons mark
(format "Day %d%s of the omer (until sunset)"
omer
(if (zerop week)
@ -930,7 +930,7 @@ although the date of death is specified by the civil calendar, the proper
Hebrew calendar yahrzeit is determined. If `european-calendar-style' is t, the
order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR.
An optional parameter MARK specifies a face or single-character string to
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((h-date (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
@ -959,7 +959,7 @@ use when highlighting the day in the calendar."
"Rosh Hodesh diary entry.
Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
An optional parameter MARK specifies a face or single-character string to
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((d (calendar-absolute-from-gregorian date))
(h-date (calendar-hebrew-from-absolute d))
@ -976,7 +976,7 @@ use when highlighting the day in the calendar."
(h-yesterday (extract-calendar-day
(calendar-hebrew-from-absolute (1- d)))))
(if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
(cons mark
(cons mark
(format
"Rosh Hodesh %s"
(if (= h-day 30)
@ -990,7 +990,7 @@ use when highlighting the day in the calendar."
(format "%s (second day)" this-month)
this-month))))
(if (= (% d 7) 6) ;; Saturday--check for Shabbat Mevarchim
(cons mark
(cons mark
(cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
(format "Mevarchim Rosh Hodesh %s (%s)"
(aref h-month-names
@ -1019,7 +1019,7 @@ use when highlighting the day in the calendar."
(defun diary-parasha (&optional mark)
"Parasha diary entry--entry applies if date is a Saturday.
An optional parameter MARK specifies a face or single-character string to
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let ((d (calendar-absolute-from-gregorian date)))
(if (= (% d 7) 6) ;; Saturday

8
lisp/calendar/cal-islam.el
View file

@ -209,7 +209,7 @@ not be marked in the calendar. This function is provided for use with the
(mark (regexp-quote diary-nonmarking-symbol)))
(calendar-for-loop i from 1 to number do
(let* ((d diary-date-forms)
(idate (calendar-islamic-from-absolute
(idate (calendar-islamic-from-absolute
(calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month idate))
(day (extract-calendar-day idate))
@ -450,7 +450,7 @@ Prefix arg will make the entry nonmarking."
(make-diary-entry
(concat
islamic-diary-entry-symbol
(calendar-date-string
(calendar-date-string
(calendar-islamic-from-absolute
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))
@ -468,7 +468,7 @@ Prefix arg will make the entry nonmarking."
(make-diary-entry
(concat
islamic-diary-entry-symbol
(calendar-date-string
(calendar-date-string
(calendar-islamic-from-absolute
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
@ -487,7 +487,7 @@ Prefix arg will make the entry nonmarking."
(make-diary-entry
(concat
islamic-diary-entry-symbol
(calendar-date-string
(calendar-date-string
(calendar-islamic-from-absolute
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))

2
lisp/calendar/cal-iso.el
View file

@ -81,7 +81,7 @@ date Sunday, December 31, 1 BC."
(defun calendar-iso-date-string (&optional date)
"String of ISO date of Gregorian DATE.
Defaults to today's date if DATE is not given."
(let* ((d (calendar-absolute-from-gregorian
(let* ((d (calendar-absolute-from-gregorian
(or date (calendar-current-date))))
(day (% d 7))
(iso-date (calendar-iso-from-absolute d)))

4
lisp/calendar/cal-julian.el
View file

@ -118,14 +118,14 @@ Driven by the variable `calendar-date-display-form'."
(mapcar 'list (append month-array nil))
nil t)
(calendar-make-alist month-array 1))))
(last
(last
(if (and (zerop (% year 4)) (= month 2))
29
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
(day (calendar-read
(format "Julian calendar day (%d-%d): "
(if (and (= year 1) (= month 1)) 3 1) last)
'(lambda (x)
'(lambda (x)
(and (< (if (and (= year 1) (= month 1)) 2 0) x)
(<= x last))))))
(list (list month day year))))

20
lisp/calendar/cal-mayan.el
View file

@ -137,7 +137,7 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
365)))
(defun calendar-next-haab-date (haab-date &optional noecho)
"Move cursor to next instance of Mayan HAAB-DATE.
"Move cursor to next instance of Mayan HAAB-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-haab-date)))
(calendar-goto-date
@ -149,7 +149,7 @@ Echo Mayan date if NOECHO is t."
(or noecho (calendar-print-mayan-date)))
(defun calendar-previous-haab-date (haab-date &optional noecho)
"Move cursor to previous instance of Mayan HAAB-DATE.
"Move cursor to previous instance of Mayan HAAB-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-haab-date)))
(calendar-goto-date
@ -199,7 +199,7 @@ Echo Mayan date if NOECHO is t."
260)))
(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
"Move cursor to next instance of Mayan TZOLKIN-DATE.
"Move cursor to next instance of Mayan TZOLKIN-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-tzolkin-date)))
(calendar-goto-date
@ -211,7 +211,7 @@ Echo Mayan date if NOECHO is t."
(or noecho (calendar-print-mayan-date)))
(defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
"Move cursor to previous instance of Mayan TZOLKIN-DATE.
"Move cursor to previous instance of Mayan TZOLKIN-DATE.
Echo Mayan date if NOECHO is t."
(interactive (list (calendar-read-mayan-tzolkin-date)))
(calendar-goto-date
@ -230,7 +230,7 @@ Echo Mayan date if NOECHO is t."
(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
"Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.
Latest such date on or before DATE.
Returns nil if such a tzolkin-haab combination is impossible."
Returns nil if such a tzolkin-haab combination is impossible."
(let* ((haab-difference
(calendar-mayan-haab-difference
(calendar-mayan-haab-from-absolute 0)
@ -253,7 +253,7 @@ Returns nil if such a tzolkin-haab combination is impossible."
(haab-day (calendar-read
"Haab kin (0-19): "
'(lambda (x) (and (>= x 0) (< x 20)))))
(haab-month-list (append calendar-mayan-haab-month-name-array
(haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
(haab-month (cdr
(assoc-ignore-case
@ -272,7 +272,7 @@ Returns nil if such a tzolkin-haab combination is impossible."
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
(assoc-ignore-case
(completing-read "Tzolkin uinal: "
(completing-read "Tzolkin uinal: "
(mapcar 'list tzolkin-name-list)
nil t)
(calendar-make-alist tzolkin-name-list 1)))))
@ -326,7 +326,7 @@ Long count is a list (baktun katun tun uinal kin)"
(defun calendar-mayan-date-string (&optional date)
"String of Mayan date of Gregorian DATE.
Defaults to today's date if DATE is not given."
(let* ((d (calendar-absolute-from-gregorian
(let* ((d (calendar-absolute-from-gregorian
(or date (calendar-current-date))))
(tzolkin (calendar-mayan-tzolkin-from-absolute d))
(haab (calendar-mayan-haab-from-absolute d))
@ -348,7 +348,7 @@ Defaults to today's date if DATE is not given."
(let (lc)
(while (not lc)
(let ((datum
(calendar-string-to-mayan-long-count
(calendar-string-to-mayan-long-count
(read-string "Mayan long count (baktun.katun.tun.uinal.kin): "
(calendar-mayan-long-count-to-string
(calendar-mayan-long-count-from-absolute
@ -361,7 +361,7 @@ Defaults to today's date if DATE is not given."
(calendar-gregorian-from-absolute
(calendar-absolute-from-mayan-long-count date)))
(or noecho (calendar-print-mayan-date)))
(defun calendar-mayan-long-count-common-era (lc)
"T if long count represents date in the Common Era."
(let ((base (calendar-mayan-long-count-from-absolute 1)))

90
lisp/calendar/cal-tex.el
View file

@ -48,7 +48,7 @@
(autoload 'calendar-iso-from-absolute "cal-iso" nil t)
;;;
;;; Customizable variables
;;; Customizable variables
;;;
(defcustom cal-tex-which-days '(0 1 2 3 4 5 6)
@ -153,9 +153,9 @@ characters with diacritical marks to their LaTeX equivalents, use
;;;
(defvar cal-tex-day-prefix "\\caldate{%s}{%s}"
"The initial LaTeX code for a day.
"The initial LaTeX code for a day.
The holidays, diary entries, bottom string, and the text follow.")
(defvar cal-tex-day-name-format "\\myday{%s}%%"
"The format for LaTeX code for a day name. The names are taken from
calendar-day-name-array.")
@ -164,7 +164,7 @@ calendar-day-name-array.")
"\\def\\calmonth#1#2%
{\\begin{center}%
\\Huge\\bf\\uppercase{#1} #2 \\\\[1cm]%
\\end{center}}%
\\end{center}}%
\\vspace*{-1.5cm}%
%
"
@ -174,7 +174,7 @@ calendar-day-name-array.")
"\\def\\calmonth#1#2#3#4%
{\\begin{center}%
\\Huge\\bf #1 #2---#3 #4\\\\[1cm]%
\\end{center}}%
\\end{center}}%
\\vspace*{-1.5cm}%
%
"
@ -517,7 +517,7 @@ Calendar is condensed onto one page."
(cal-tex-end-document)))
(run-hooks 'cal-tex-hook))
(defun cal-tex-insert-days (month year diary-list holidays day-format)
(defun cal-tex-insert-days (month year diary-list holidays day-format)
"Insert LaTeX commands for a range of days in monthly calendars.
LaTeX commands are inserted for the days of the MONTH in YEAR.
Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS are included.
@ -532,7 +532,7 @@ Each day is formatted using format DAY-FORMAT."
(calendar-for-loop i from 1 to last do
(setq date (list month i year))
(if (memq (calendar-day-of-week date) cal-tex-which-days)
(progn
(progn
(insert (format day-format (cal-tex-month-name month) i))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
@ -549,21 +549,21 @@ Each day is formatted using format DAY-FORMAT."
"Insert the names of the days at top of a monthly calendar."
(calendar-for-loop i from 0 to 6 do
(if (memq i cal-tex-which-days)
(insert (format cal-tex-day-name-format
(insert (format cal-tex-day-name-format
(cal-tex-LaTeXify-string
(aref calendar-day-name-array
(aref calendar-day-name-array
(mod (+ calendar-week-start-day i) 7))))))
(cal-tex-comment)))
(defun cal-tex-insert-month-header (n month year end-month end-year)
"Create a title for a calendar.
A title is inserted for a calendar with N months starting with
A title is inserted for a calendar with N months starting with
MONTH YEAR and ending with END-MONTH END-YEAR."
(let ((month-name (cal-tex-month-name month))
(end-month-name (cal-tex-month-name end-month)))
(if (= 1 n)
(insert (format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}"
month-name year) )
month-name year) )
(insert (format "\\calmonth{%s}{%s}{%s}{%s}\n\\vspace*{-0.5cm}"
month-name year end-month-name end-year))))
(cal-tex-comment))
@ -579,7 +579,7 @@ blank, no days are inserted."
(- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
7)))
(calendar-for-loop i from 0 to (1- blank-days) do
(calendar-for-loop i from 0 to (1- blank-days) do
(if (memq i cal-tex-which-days)
(insert (format day-format " " " ") "{}{}{}{}%\n"))))))
@ -594,7 +594,7 @@ The entry is formatted using DAY-FORMAT."
(- (calendar-day-of-week (list month last-day year))
calendar-week-start-day)
7)))
(calendar-for-loop i from (1+ blank-days) to 6 do
(calendar-for-loop i from (1+ blank-days) to 6 do
(if (memq i cal-tex-which-days)
(insert (format day-format "" "") "{}{}{}{}%\n"))))))
@ -631,8 +631,8 @@ in the calendar starting in MONTH YEAR."
(defun cal-tex-number-weeks (month year n)
"Determine the number of weeks in a range of dates.
Compute the number of weeks in the calendar starting with MONTH and YEAR,
and lasting N months, including only the days in WHICH-DAYS. As it stands,
Compute the number of weeks in the calendar starting with MONTH and YEAR,
and lasting N months, including only the days in WHICH-DAYS. As it stands,
this is only an upper bound."
(let ((d (list month 1 year)))
(increment-calendar-month month year (1- n))
@ -687,7 +687,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-e-center)
(cal-tex-hspace "-.2in")
(cal-tex-b-parbox "l" "7in")
(calendar-for-loop j from 1 to 7 do
(calendar-for-loop j from 1 to 7 do
(cal-tex-week-hours date holidays "3.1")
(setq date (cal-tex-incr-date date)))
(cal-tex-e-parbox)
@ -739,7 +739,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-e-center)
(cal-tex-hspace "-.2in")
(cal-tex-b-parbox "l" "\\textwidth")
(calendar-for-loop j from 1 to 3 do
(calendar-for-loop j from 1 to 3 do
(cal-tex-week-hours date holidays "5")
(setq date (cal-tex-incr-date date)))
(cal-tex-e-parbox)
@ -767,7 +767,7 @@ Holidays are included if `cal-tex-holidays' is t."
(insert "}")
(cal-tex-nl)
(cal-tex-b-parbox "l" "\\textwidth")
(calendar-for-loop j from 4 to 7 do
(calendar-for-loop j from 4 to 7 do
(cal-tex-week-hours date holidays "5")
(setq date (cal-tex-incr-date date)))
(cal-tex-e-parbox)
@ -825,7 +825,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-nl ".5cm")
(cal-tex-e-center)
(cal-tex-b-parbox "l" "\\textwidth")
(calendar-for-loop j from 1 to 7 do
(calendar-for-loop j from 1 to 7 do
(cal-tex-b-parbox "t" "\\textwidth")
(cal-tex-b-parbox "t" "\\textwidth")
(cal-tex-rule "0pt" "\\textwidth" ".2mm")
@ -870,13 +870,13 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-end-document)
(run-hooks 'cal-tex-hook)))
(defvar cal-tex-LaTeX-hourbox
(defvar cal-tex-LaTeX-hourbox
"\\newcommand{\\hourbox}[2]%
{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n"
"One hour and a line on the right.")
(defun cal-tex-week-hours (date holidays height)
"Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT."
"Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
@ -971,14 +971,14 @@ Holidays are included if `cal-tex-holidays' is t."
(calendar-for-loop i from 8 to 12 do
(insert (format "{\\large\\sf %d}\\\\\n" i)))
(calendar-for-loop i from 1 to 5 do
(insert (format "{\\large\\sf %d}\\\\\n"
(insert (format "{\\large\\sf %d}\\\\\n"
(if cal-tex-24 (+ i 12) i))))))
(cal-tex-nl ".5cm")
(if weekend
(progn
(cal-tex-vspace "1cm")
(insert "\\ \\vfill")
(insert (format "{\\Large\\bf %s,} %s/%s/%s\\\\\n"
(insert (format "{\\Large\\bf %s,} %s/%s/%s\\\\\n"
dayname1 month1 day1 year1))
(cal-tex-rule "0pt" "7.5cm" ".5mm")
(cal-tex-nl "1.5cm")
@ -1070,7 +1070,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
(insert "%\n")
(calendar-for-loop j from 1 to 7 do
(calendar-for-loop j from 1 to 7 do
(if (= (mod i 2) 1)
(insert "\\rightday")
(insert "\\leftday"))
@ -1091,7 +1091,7 @@ Holidays are included if `cal-tex-holidays' is t."
(defun cal-tex-cursor-filofax-week (&optional arg)
"One-week-at-a-glance Filofax style calendar for week indicated by cursor.
Optional prefix argument specifies number of weeks.
Weeks start on Monday.
Weeks start on Monday.
Diary entries are included if `cal-tex-diary' is t.
Holidays are included if `cal-tex-holidays' is t."
(interactive "p")
@ -1179,7 +1179,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
(insert "%\n")
(calendar-for-loop j from 1 to 3 do
(calendar-for-loop j from 1 to 3 do
(insert "\\leftday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
@ -1214,7 +1214,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
(insert "%\n")
(calendar-for-loop j from 1 to 2 do
(calendar-for-loop j from 1 to 2 do
(insert "\\rightday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
@ -1223,7 +1223,7 @@ Holidays are included if `cal-tex-holidays' is t."
(cal-tex-arg (eval cal-tex-daily-string))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(calendar-for-loop j from 1 to 2 do
(calendar-for-loop j from 1 to 2 do
(insert "\\weekend")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
@ -1241,7 +1241,7 @@ Holidays are included if `cal-tex-holidays' is t."
(defun cal-tex-cursor-filofax-daily (&optional arg)
"Day-per-page Filofax style calendar for week indicated by cursor.
Optional prefix argument specifies number of weeks. Weeks start on Monday.
Optional prefix argument specifies number of weeks. Weeks start on Monday.
Diary entries are included if `cal-tex-diary' is t.
Holidays are included if `cal-tex-holidays' is t.
Pages are ruled if `cal-tex-rules' is t."
@ -1309,7 +1309,7 @@ Pages are ruled if `cal-tex-rules' is t."
(cal-tex-b-document)
(cal-tex-cmd "\\pagestyle{empty}")
(calendar-for-loop i from 1 to n do
(calendar-for-loop j from 1 to 5 do
(calendar-for-loop j from 1 to 5 do
(let ((odd (/= 0 (% j 2))))
(insert (if odd "\\righthead" "\\lefthead"))
(cal-tex-arg (calendar-date-string date))
@ -1325,7 +1325,7 @@ Pages are ruled if `cal-tex-rules' is t."
(cal-tex-newpage)
(setq date (cal-tex-incr-date date)))
(insert "%\n")
(calendar-for-loop j from 1 to 2 do
(calendar-for-loop j from 1 to 2 do
(insert "\\lefthead")
(cal-tex-arg (calendar-date-string date))
(insert "\\weekend")
@ -1436,7 +1436,7 @@ Optional prefix argument specifies number of days."
(cal-tex-hfill)
(insert "}")
(cal-tex-banner "end of cal-tex-daily-page")))
;;;
;;; Mini calendars
;;;
@ -1471,7 +1471,7 @@ COLSEP gives the column separation; 1mm is the default."
(setq str
(concat str
(cal-tex-LaTeXify-string
(substring (aref calendar-day-name-array
(substring (aref calendar-day-name-array
(mod (+ calendar-week-start-day i) 7))
0 2))
(if (/= i 6)
@ -1538,12 +1538,12 @@ FINAL-SEPARATOR is t."
(defun cal-tex-end-document ()
"Finish the LaTeX document.
Insert the trailer to LaTeX document, pop to LaTeX buffer, add
Insert the trailer to LaTeX document, pop to LaTeX buffer, add
informative header, and run HOOK."
(cal-tex-e-document)
(latex-mode)
(pop-to-buffer cal-tex-buffer)
(goto-char (point-min))
(goto-char (point-min))
(cal-tex-comment " This buffer was produced by cal-tex.el.")
(cal-tex-comment " To print a calendar, type")
(cal-tex-comment " M-x tex-buffer RET")
@ -1552,8 +1552,8 @@ informative header, and run HOOK."
(defun cal-tex-insert-preamble (weeks landscape size &optional append)
"Initialize the output buffer.
Select the output buffer, and insert the preamble for a calendar of
WEEKS weeks. Insert code for landscape mode if LANDSCAPE is true.
Select the output buffer, and insert the preamble for a calendar of
WEEKS weeks. Insert code for landscape mode if LANDSCAPE is true.
Use pointsize SIZE. Optional argument APPEND, if t, means add to end of
without erasing current contents."
(let ((width "18cm")
@ -1565,7 +1565,7 @@ without erasing current contents."
(if (not append)
(progn
(cal-tex-preamble size)
(if (not landscape)
(if (not landscape)
(progn
(cal-tex-cmd "\\oddsidemargin -1.75cm")
(cal-tex-cmd "\\def\\holidaymult{.06}"))
@ -1583,16 +1583,16 @@ without erasing current contents."
(/ 1.1 (length cal-tex-which-days))))
(cal-tex-cmd "\\setlength{\\cellheight}" height)
(insert (format "\\setlength{\\cellheight}{%f\\cellheight}\n"
(/ 1.0 weeks)))
(/ 1.0 weeks)))
(cal-tex-cmd "\\ \\par")
(cal-tex-vspace "-3cm")))
(defvar cal-tex-LaTeX-subst-list
'(("\"". "``")
("\"". "''");; Quote changes meaning when list is reversed.
("@" . "\\verb|@|")
("&" . "\\&")
("%" . "\\%")
("@" . "\\verb|@|")
("&" . "\\&")
("%" . "\\%")
("$" . "\\$")
("#" . "\\#")
("_" . "\\_")
@ -1658,11 +1658,11 @@ without erasing current contents."
(defun cal-tex-nl (&optional skip comment)
"End a line with \\. If SKIP, then add that much spacing.
Add COMMENT if present"
(insert "\\\\")
(if skip
(insert "\\\\")
(if skip
(insert "[" skip "]"))
(cal-tex-comment comment))
(defun cal-tex-arg (&optional text)
"Insert optional TEXT surrounded by braces."
(insert "{")

8
lisp/calendar/cal-x.el
View file

@ -42,7 +42,7 @@
(defvar calendar-frame nil "Frame in which to display the calendar.")
(defvar diary-frame nil "Frame in which to display the diary.")
;; This should not specify the font. That's up to the user.
;; Certainly it should not specify auto-lower and auto-raise
;; since most users won't like that.
@ -51,7 +51,7 @@
(unsplittable . t) (minibuffer . nil))
"Parameters of the diary frame, if the diary is in its own frame.
Location and color should be set in .Xdefaults.")
(defvar calendar-frame-parameters
'((name . "Calendar") (title . "Calendar") (minibuffer . nil)
(height . 10) (width . 80) (unsplittable . t) (vertical-scroll-bars . nil))
@ -63,11 +63,11 @@ Location and color should be set in .Xdefaults.")
(minibuffer . nil))
"Parameters of the frame that displays both the calendar and the diary.
Location and color should be set in .Xdefaults.")
(defvar calendar-after-frame-setup-hooks nil
"Hooks to be run just after setting up a calendar frame.
Can be used to change frame parameters, such as font, color, location, etc.")
(defun calendar-one-frame-setup (&optional arg)
"Start calendar and display it in a dedicated frame together with the diary."
(if (not (display-multi-frame-p))

2
lisp/calendar/diary-lib.el
View file

@ -1721,7 +1721,7 @@ If optional NOABBREV is t, do not allow abbreviations in names."
'("[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
. font-lock-function-name-face)))
"Forms to highlight in diary-mode")
(provide 'diary-lib)

4
lisp/calendar/holidays.el
View file

@ -149,7 +149,7 @@ The optional LABEL is used to label the buffer created."
(name (if (string-equal choice "Equinoxes/Solstices")
choice
(if (member choice '("Ask" ""))
"Holidays"
"Holidays"
(format "%s Holidays" choice)))))
(list start-year end-year which name)))
(message "Computing holidays...")
@ -466,7 +466,7 @@ date. If date is nil, or if the date is not visible, there is no holiday."
(filter-visible-calendar-holidays mandatory)))
(if all-christian-calendar-holidays
(setq output-list
(append
(append
(filter-visible-calendar-holidays optional)
output-list)))
output-list)))

4
lisp/calendar/lunar.el
View file

@ -64,7 +64,7 @@
(increment-calendar-month end-month end-year 3)
(increment-calendar-month start-month start-year -1)
(let* ((end-date (list (list end-month 1 end-year)))
(start-date (list (list start-month
(start-date (list (list start-month
(calendar-last-day-of-month
start-month start-year)
start-year)))
@ -239,7 +239,7 @@ This function is suitable for execution in a .emacs file."
(defun diary-phases-of-moon (&optional mark)
"Moon phases diary entry.
An optional parameter MARK specifies a face or single-character string to
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((index (* 4
(truncate

58
lisp/calendar/solar.el
View file

@ -194,8 +194,8 @@ delta. At present, delta = 0.01 degrees, so the value of the variable
'("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
"List of season changes for the southern hemisphere.")
(defvar solar-sidereal-time-greenwich-midnight
nil
(defvar solar-sidereal-time-greenwich-midnight
nil
"Sidereal time at Greenwich at midnight (universal time).")
(defvar solar-northern-spring-or-summer-season nil
@ -239,7 +239,7 @@ Returns nil if nothing was entered."
(condition-case nil
(tan (degrees-to-radians (mod x 360.0)))
(solar-tangent-degrees x)))
(defun solar-xy-to-quadrant (x y)
"Determines the quadrant of the point X, Y."
(if (> x 0)
@ -399,7 +399,7 @@ Format used is given by `calendar-time-display-form'."
(floor (* 60 (- time (floor time))))))
(defun solar-exact-local-noon (date)
"Date and Universal Time of local noon at *local date* date.
"Date and Universal Time of local noon at *local date* date.
The date may be different from the one asked for, but it will be the right
local date. The second component of date should be an integer."
@ -408,12 +408,12 @@ local date. The second component of date should be an integer."
(te (solar-time-equation date ut)))
(setq ut (- ut te))
(if (>= ut 24)
(progn
(progn
(setq nd (list (car date) (+ 1 (car (cdr date)))
(car (cdr (cdr date)))))
(setq ut (- ut 24))))
(if (< ut 0)
(progn
(progn
(setq nd (list (car date) (- (car (cdr date)) 1)
(car (cdr (cdr date)))))
(setq ut (+ ut 24))))
@ -477,10 +477,10 @@ Corresponding value is nil if there is no sunrise/sunset."
(defun solar-julian-ut-centuries (date)
"Number of Julian centuries elapsed since 1 Jan, 2000 at noon U.T. for Gregorian DATE."
(/ (- (calendar-absolute-from-gregorian date)
(/ (- (calendar-absolute-from-gregorian date)
(calendar-absolute-from-gregorian '(1 1.5 2000)))
36525.0))
(defun solar-ephemeris-time(time)
"Ephemeris Time at moment TIME.
@ -534,7 +534,7 @@ calendar-time-zone are used to interpret local time."
(setq end-long long)))
(/ (+ start end) 2.0)))
(defun solar-horizontal-coordinates
(defun solar-horizontal-coordinates
(time latitude longitude for-sunrise-sunset)
"Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
@ -557,7 +557,7 @@ The azimuth is given in degrees as well as the height (between -180 and 180)."
(* (solar-tangent-degrees de)
(solar-cosine-degrees latitude)))
(solar-sin-degrees ah)))
(height (solar-arcsin
(height (solar-arcsin
(+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
(* (solar-cosine-degrees latitude)
(solar-cosine-degrees de)
@ -573,7 +573,7 @@ elapsed at 0 Universal Time, and the second component being the universal
time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."
(let* ((tm (solar-ephemeris-time time))
(let* ((tm (solar-ephemeris-time time))
(ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))
(list (solar-right-ascension (car ec) (car (cdr ec)))
(solar-declination (car ec) (car (cdr ec))))))
@ -585,16 +585,16 @@ at moment `time', expressed in julian centuries of Ephemeris Time
since January 1st, 2000, at 12 ET."
(let* ((l (+ 280.46645
(* 36000.76983 time)
(* 0.0003032 time time))) ; sun mean longitude
(* 0.0003032 time time))) ; sun mean longitude
(ml (+ 218.3165
(* 481267.8813 time))) ; moon mean longitude
(* 481267.8813 time))) ; moon mean longitude
(m (+ 357.52910
(* 35999.05030 time)
(* -0.0001559 time time)
(* -0.00000048 time time time))) ; sun mean anomaly
(* -0.00000048 time time time))) ; sun mean anomaly
(i (+ 23.43929111 (* -0.013004167 time)
(* -0.00000016389 time time)
(* 0.0000005036 time time time))); mean inclination
(* 0.0000005036 time time time))); mean inclination
(c (+ (* (+ 1.914600
(* -0.004817 time)
(* -0.000014 time time))
@ -602,8 +602,8 @@ since January 1st, 2000, at 12 ET."
(* (+ 0.019993 (* -0.000101 time))
(solar-sin-degrees (* 2 m)))
(* 0.000290
(solar-sin-degrees (* 3 m))))) ; center equation
(L (+ l c)) ; total longitude
(solar-sin-degrees (* 3 m))))) ; center equation
(L (+ l c)) ; total longitude
(omega (+ 125.04
(* -1934.136 time))) ; longitude of moon's ascending node
; on the ecliptic
@ -624,13 +624,13 @@ since January 1st, 2000, at 12 ET."
(* -0.00478
(solar-sin-degrees omega)))) ; apparent longitude of sun
(y (if (not for-sunrise-sunset)
(* (solar-tangent-degrees (/ i 2))
(* (solar-tangent-degrees (/ i 2))
(solar-tangent-degrees (/ i 2)))
nil))
(time-eq (if (not for-sunrise-sunset)
(/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
(* -2 ecc (solar-sin-degrees m))
(* 4 ecc y (solar-sin-degrees m)
(* 4 ecc y (solar-sin-degrees m)
(solar-cosine-degrees (* 2 l)))
(* -0.5 y y (solar-sin-degrees (* 4 l)))
(* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
@ -807,7 +807,7 @@ T0 must correspond to 0 hours UT."
(nut-i (solar-ecliptic-coordinates et nil))
(nut (car (cdr (cdr (cdr nut-i))))) ; nutation
(i (car (cdr nut-i)))) ; inclination
(mod (+ (mod (+ mean-sid-time
(mod (+ (mod (+ mean-sid-time
(/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
24.0)
24.0)))
@ -895,7 +895,7 @@ This function is suitable for execution in a .emacs file."
"Type \\[delete-other-windows] to remove temp window."
"Type \\[switch-to-buffer] RET to remove temp window.")
"Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))
(defun calendar-sunrise-sunset ()
"Local time of sunrise and sunset for date under cursor.
Accurate to a few seconds."
@ -924,7 +924,7 @@ Accurate to a few seconds."
"Local time of candle lighting diary entry--applies if date is a Friday.
No diary entry if there is no sunset on that date.
An optional parameter MARK specifies a face or single-character string to
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(if (not (and calendar-latitude calendar-longitude calendar-time-zone))
(solar-setup))
@ -942,7 +942,7 @@ use when highlighting the day in the calendar."
(defun solar-equinoxes/solstices (k year)
"Date of equinox/solstice K for YEAR.
K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;
K=3, winter solstice.
K=3, winter solstice.
RESULT is a gregorian local date.
Accurate to less than a minute between 1951 and 2050."
@ -951,13 +951,13 @@ Accurate to less than a minute between 1951 and 2050."
(W (- (* 35999.373 T) 2.47))
(Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
(* 0.0007 (solar-cosine-degrees (* 2 W)))))
(S (apply '+ (mapcar '(lambda(x)
(* (car x) (solar-cosine-degrees
(S (apply '+ (mapcar '(lambda(x)
(* (car x) (solar-cosine-degrees
(+ (* (car (cdr (cdr x))) T)
(car (cdr x))))))
(car (cdr x))))))
solar-seasons-data)))
(JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))
(correction (+ 102.3 (* 123.5 T) (* 32.5 T T)))
(correction (+ 102.3 (* 123.5 T) (* 32.5 T T)))
; ephemeris time correction
(JD (- JDE (/ correction 86400)))
(date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))
@ -969,7 +969,7 @@ Accurate to less than a minute between 1951 and 2050."
; from Meeus, 1991, page 166
(defun solar-mean-equinoxes/solstices (k year)
"Julian day of mean equinox/solstice K for YEAR.
"Julian day of mean equinox/solstice K for YEAR.
K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
solstice. These formulas are only to be used between 1000 BC and 3000 AD."
(let ((y (/ year 1000.0))
@ -1061,7 +1061,7 @@ Requires floating point."
(if calendar-time-zone calendar-daylight-savings-ends))
(calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
(k (1- (/ m 3)))
(d0 (solar-equinoxes/solstices k y))
(d0 (solar-equinoxes/solstices k y))
(d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))
(h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))
(adj (dst-adjust-time d1 h0))

2
lisp/calendar/timeclock.el
View file

@ -125,7 +125,7 @@ If this variable is nil, no questions will be asked."
The first time that a user clocks in each day, this function will be
called to determine what the length of the current workday is. If
the return value is nil, or equal to `timeclock-workday', nothing special
will be done. If it is a quantity different from `timeclock-workday',
will be done. If it is a quantity different from `timeclock-workday',
however, a record will be output to the timelog file to note the fact that
that day has a different length from the norm."
:type '(choice (const nil) function)

16
lisp/emacs-lisp/authors.el
View file

@ -92,7 +92,7 @@ files.")
("Per Abrahamsen" "Per Abhiddenware")
("Peter S. Galbraith" "Peter S Galbraith")
("Richard M. Stallman" "Richard M. Stallman,,," "Richard Stallman"
"rms" "rms@gnu.org")
"rms" "rms@gnu.org")
("Robert J. Chassell" "Bob Chassell")
("Roland B. Roberts" "Roland B Roberts" "Roland Roberts")
("Rui-Tao Dong" "Rui-Tao Dong ~{6-Hpln~}")
@ -110,7 +110,7 @@ files.")
"Alist of author aliases.
Each entry is of the form (REALNAME REGEXP...). If an author's name
matches one of the REGEXPs, use REALNAME instead.
matches one of the REGEXPs, use REALNAME instead.
If REALNAME is nil, ignore that author.")
@ -321,7 +321,7 @@ the file name."
(setq authors-checked-files-alist
(cons (cons file valid) authors-checked-files-alist))
(unless valid
(setq authors-invalid-file-names
(setq authors-invalid-file-names
(cons (format "%s:%d: unrecognized `%s' for %s"
log-file
(1+ (count-lines (point-min) pos))
@ -510,7 +510,7 @@ TABLE is a hash table to add author information to."
CHANGES is an alist of entries (FILE (ACTION . COUNT) ...), as produced by
`authors-scan-change-log'.
The element added to `authors-author-list' is (AUTHOR WROTE CHANGED), where
WROTE and CHANGED are lists of the files written and changed by AUTHOR."
WROTE and CHANGED are lists of the files written and changed by AUTHOR."
(when author
(let ((nchanged 0)
wrote-list
@ -549,7 +549,7 @@ WROTE and CHANGED are lists of the files written and changed by AUTHOR."
(defun authors (root)
"Extract author information from change logs and Lisp source files.
ROOT is the root directory under which to find the files. If called
interactively, ROOT is read from the minibuffer.
interactively, ROOT is read from the minibuffer.
Result is a buffer *Authors* containing authorship information, and a
buffer *Authors Errors* containing references to unknown files."
(interactive "DEmacs source directory: ")
@ -575,14 +575,14 @@ buffer *Authors Errors* containing references to unknown files."
(set-buffer (get-buffer-create buffer-name))
(erase-buffer)
(set-buffer-file-coding-system authors-coding-system)
(insert
(insert
"Many people have contributed code included in the Free Software
Foundation's distribution of GNU Emacs. To show our appreciation for
their public spirit, we list here in alphabetical order a condensed
list of their contributions.\n")
(let (authors-author-list a)
(maphash #'authors-add-to-author-list table)
(setq authors-author-list
(setq authors-author-list
(sort authors-author-list
(lambda (a b) (string-lessp (car a) (car b)))))
(dolist (a authors-author-list)
@ -607,7 +607,7 @@ list of their contributions.\n")
(insert "\n "))
(insert " " file))
(insert "\n")))))
(insert "\nLocal" " Variables:\ncoding: "
(insert "\nLocal" " Variables:\ncoding: "
(symbol-name authors-coding-system) "\nEnd:\n")
(message "Generating buffer %s... done" buffer-name)
(unless noninteractive

2
lisp/emacs-lisp/autoload.el
View file

@ -318,7 +318,7 @@ are used."
(setq autoload form))
(let ((autoload-print-form-outbuf outbuf))
(autoload-print-form autoload)))
;; Copy the rest of the line to the output.
(princ (buffer-substring
(progn

4
lisp/emacs-lisp/backquote.el
View file

@ -142,7 +142,7 @@ Vectors work just like lists. Nested backquotes are permitted."
;; Scan this list-level, setting LISTS to a list of forms,
;; each of which produces a list of elements
;; that should go in this level.
;; The order of LISTS is backwards.
;; The order of LISTS is backwards.
;; If there are non-splicing elements (constant or variable)
;; at the beginning, put them in FIRSTLIST,
;; as a list of tagged values (TAG . FORM).
@ -172,7 +172,7 @@ Vectors work just like lists. Nested backquotes are permitted."
(if (or rest list)
(setq lists (cons (backquote-listify list (backquote-process rest))
lists)))
;; Turn LISTS into a form that produces the combined list.
;; Turn LISTS into a form that produces the combined list.
(setq expression
(if (or (cdr lists)
(eq (car-safe (car lists)) backquote-splice-symbol))

44
lisp/emacs-lisp/bindat.el
View file

@ -33,22 +33,22 @@
;; and encoding binary data formats like these is made simple using a
;; structure specification which closely resembles the C style
;; structure declarations.
;;
;;
;; Encoded (binary) data is stored in a unibyte string or vector,
;; while the decoded data is stored in an alist with (FIELD . VALUE)
;; while the decoded data is stored in an alist with (FIELD . VALUE)
;; pairs.
;; Example:
;; Consider the following C structures:
;;
;;
;; struct header {
;; unsigned long dest_ip;
;; unsigned long src_ip;
;; unsigned short dest_port;
;; unsigned short src_port;
;; };
;;
;;
;; struct data {
;; unsigned char type;
;; unsigned char opcode;
@ -56,22 +56,22 @@
;; unsigned char id[8]; /* nul-terminated string */
;; unsigned char data[/* (length + 3) & ~3 */];
;; };
;;
;;
;; struct packet {
;; struct header header;
;; unsigned char items;
;; unsigned char filler[3];
;; struct data item[/* items */];
;; };
;;
;;
;; The corresponding Lisp bindat specification looks like this:
;;
;;
;; (setq header-spec
;; '((dest-ip ip)
;; (src-ip ip)
;; (dest-port u16)
;; (src-port u16)))
;;
;;
;; (setq data-spec
;; '((type u8)
;; (opcode u8)
@ -79,20 +79,20 @@
;; (id strz 8)
;; (data vec (length))
;; (align 4)))
;;
;;
;; (setq packet-spec
;; '((header struct header-spec)
;; (items u8)
;; (fill 3)
;; (item repeat (items)
;; ((struct data-spec)))))
;;
;;
;;
;; A binary data representation may look like
;; [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0
;; [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0
;; 2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0
;; 1 4 7 0 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ]
;;
;;
;; The corresponding decoded structure looks like
;;
;; ((header
@ -176,7 +176,7 @@
;; A `union' specification
;; ([FIELD] union TAG_VAL (TAG SPEC) ... [(t SPEC)])
;; is interpreted by evalling TAG_VAL and then comparing that to
;; is interpreted by evalling TAG_VAL and then comparing that to
;; each TAG using equal; if a match is found, the corresponding SPEC
;; is used.
;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
@ -204,7 +204,7 @@
(string-to-char (substring raw-data pos (1+ pos)))
(aref raw-data pos))
(setq pos (1+ pos))))
(defun bindat--unpack-u16 ()
(let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
(logior (lsh a 8) b)))
@ -341,7 +341,7 @@
(setq struct (cons (cons field data) struct))
(setq struct (append data struct))))))
struct))
(defun bindat-unpack (spec raw-data &optional pos)
"Return structured data according to SPEC for binary data in RAW-DATA.
RAW-DATA is a string or vector. Optional third arg POS specifies the
@ -365,7 +365,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
struct)
;; Calculate raw-data length of structured data
;; Calculate raw-data length of structured data
(defvar bindat--fixed-length-alist
'((u8 . 1) (byte . 1)
@ -398,7 +398,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq len (apply 'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
@ -446,7 +446,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(defun bindat--pack-u8 (v)
(aset raw-data pos (logand v 255))
(setq pos (1+ pos)))
(defun bindat--pack-u16 (v)
(aset raw-data pos (logand (lsh v -8) 255))
(aset raw-data (1+ pos) (logand v 255))
@ -513,7 +513,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(aset raw-data (+ pos i) (aref v i))
(setq i (1+ i)))
(setq pos (+ pos len))))
(t
(t
(setq pos (+ pos len)))))
(defun bindat--pack-group (struct spec)
@ -540,7 +540,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq len (apply 'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
@ -601,7 +601,7 @@ only that many elements from VECT."
(setq i (1- i)
s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
(apply 'concat s)))
(defun bindat-vector-to-dec (vect &optional sep)
"Format vector VECT in decimal format separated by dots.
If optional second arg SEP is a string, use that as separator."

66
lisp/emacs-lisp/byte-opt.el
View file

@ -31,7 +31,7 @@
;; You can, however, make a faster pig."
;;
;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code
;; makes it be a VW Bug with fuel injection and a turbocharger... You're
;; makes it be a VW Bug with fuel injection and a turbocharger... You're
;; still not going to make it go faster than 70 mph, but it might be easier
;; to get it there.
;;
@ -62,17 +62,17 @@
;; Simple defsubsts often produce forms like
;; (let ((v1 (f1)) (v2 (f2)) ...)
;; (FN v1 v2 ...))
;; It would be nice if we could optimize this to
;; It would be nice if we could optimize this to
;; (FN (f1) (f2) ...)
;; but we can't unless FN is dynamically-safe (it might be dynamically
;; referring to the bindings that the lambda arglist established.)
;; One of the uncountable lossages introduced by dynamic scope...
;;
;; Maybe there should be a control-structure that says "turn on
;; Maybe there should be a control-structure that says "turn on
;; fast-and-loose type-assumptive optimizations here." Then when
;; we see a form like (car foo) we can from then on assume that
;; the variable foo is of type cons, and optimize based on that.
;; But, this won't win much because of (you guessed it) dynamic
;; But, this won't win much because of (you guessed it) dynamic
;; scope. Anything down the stack could change the value.
;; (Another reason it doesn't work is that it is perfectly valid
;; to call car with a null argument.) A better approach might
@ -107,7 +107,7 @@
;;
;; However, if there was even a single let-binding around the COND,
;; it could not be byte-compiled, because there would be an "unbind"
;; byte-op between the final "call" and "return." Adding a
;; byte-op between the final "call" and "return." Adding a
;; Bunbind_all byteop would fix this.
;;
;; (defun foo (x y z) ... (foo a b c))
@ -129,8 +129,8 @@
;;
;; Wouldn't it be nice if Emacs Lisp had lexical scope.
;;
;; Idea: the form (lexical-scope) in a file means that the file may be
;; compiled lexically. This proclamation is file-local. Then, within
;; Idea: the form (lexical-scope) in a file means that the file may be
;; compiled lexically. This proclamation is file-local. Then, within
;; that file, "let" would establish lexical bindings, and "let-dynamic"
;; would do things the old way. (Or we could use CL "declare" forms.)
;; We'd have to notice defvars and defconsts, since those variables should
@ -140,10 +140,10 @@
;; in the file being compiled (doing a boundp check isn't good enough.)
;; Fdefvar() would have to be modified to add something to the plist.
;;
;; A major disadvantage of this scheme is that the interpreter and compiler
;; would have different semantics for files compiled with (dynamic-scope).
;; A major disadvantage of this scheme is that the interpreter and compiler
;; would have different semantics for files compiled with (dynamic-scope).
;; Since this would be a file-local optimization, there would be no way to
;; modify the interpreter to obey this (unless the loader was hacked
;; modify the interpreter to obey this (unless the loader was hacked
;; in some grody way, but that's a really bad idea.)
;; Other things to consider:
@ -157,7 +157,7 @@
;;;;; error free also they may act as true-constants.
;;;(disassemble (lambda (x) (and (point) (foo))))
;;;;; When
;;;;; When
;;;;; - all but one arguments to a function are constant
;;;;; - the non-constant argument is an if-expression (cond-expression?)
;;;;; then the outer function can be distributed. If the guarding
@ -285,7 +285,7 @@
form))))))
;;; ((lambda ...) ...)
;;;
;;;
(defun byte-compile-unfold-lambda (form &optional name)
(or name (setq name "anonymous lambda"))
(let ((lambda (car form))
@ -338,13 +338,13 @@
(byte-compile-warn
"attempt to open-code `%s' with too many arguments" name))
form)
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
;; byte-compile that file.
;(setq body (mapcar 'byte-optimize-form body)))
(let ((newform
(let ((newform
(if bindings
(cons 'let (cons (nreverse bindings) body))
(cons 'progn body))))
@ -427,21 +427,21 @@
(cons (byte-optimize-form (nth 1 form) t)
(cons (byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (cdr (cdr (cdr form))) t)))))
((memq fn '(save-excursion save-restriction save-current-buffer))
;; those subrs which have an implicit progn; it's not quite good
;; enough to treat these like normal function calls.
;; This can turn (save-excursion ...) into (save-excursion) which
;; will be optimized away in the lap-optimize pass.
(cons fn (byte-optimize-body (cdr form) for-effect)))
((eq fn 'with-output-to-temp-buffer)
;; this is just like the above, except for the first argument.
(cons fn
(cons
(byte-optimize-form (nth 1 form) nil)
(byte-optimize-body (cdr (cdr form)) for-effect))))
((eq fn 'if)
(when (< (length form) 3)
(byte-compile-warn "too few arguments for `if'"))
@ -450,7 +450,7 @@
(cons
(byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (nthcdr 3 form) for-effect)))))
((memq fn '(and or)) ; remember, and/or are control structures.
;; take forms off the back until we can't any more.
;; In the future it could conceivably be a problem that the
@ -474,7 +474,7 @@
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
nil)
((memq fn '(defun defmacro function
condition-case save-window-excursion))
;; These forms are compiled as constants or by breaking out
@ -490,7 +490,7 @@
(cons fn
(cons (byte-optimize-form (nth 1 form) for-effect)
(cdr (cdr form)))))
((eq fn 'catch)
;; the body of a catch is compiled (and thus optimized) as a
;; top-level form, so don't do it here. The tag is never
@ -523,7 +523,7 @@
(not (eq form
(setq form (compiler-macroexpand form)))))
(byte-optimize-form form for-effect))
((not (symbolp fn))
(byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn))
@ -552,7 +552,7 @@
;; appending a nil here might not be necessary, but it can't hurt.
(byte-optimize-form
(cons 'progn (append (cdr form) '(nil))) t))
(t
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
@ -622,7 +622,7 @@
((keywordp ,form))))
;; If the function is being called with constant numeric args,
;; evaluate as much as possible at compile-time. This optimizer
;; evaluate as much as possible at compile-time. This optimizer
;; assumes that the function is associative, like + or *.
(defun byte-optimize-associative-math (form)
(let ((args nil)
@ -816,7 +816,7 @@
(cons (/ (nth 1 form) last)
(byte-compile-butlast (cdr (cdr form)))))
last nil))))
(cond
(cond
;;; ((null (cdr (cdr form)))
;;; (nth 1 form))
((eq (nth 1 form) 0)
@ -912,7 +912,7 @@
(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; take care of this? - Jamie
;; I think this may some times be necessary to reduce ie (quote 5) to 5,
;; so arithmetic optimizers recognize the numeric constant. - Hallvard
@ -1169,7 +1169,7 @@
nil
form))
;;; enumerating those functions which need not be called if the returned
;;; enumerating those functions which need not be called if the returned
;;; value is not used. That is, something like
;;; (progn (list (something-with-side-effects) (yow))
;;; (foo))
@ -1233,7 +1233,7 @@
zerop))
(side-effect-and-error-free-fns
'(arrayp atom
bobp bolp bool-vector-p
bobp bolp bool-vector-p
buffer-end buffer-list buffer-size buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
current-buffer current-global-map current-indentation
@ -1440,7 +1440,7 @@
byte-current-buffer byte-interactive-p))
(defconst byte-compile-side-effect-free-ops
(nconc
(nconc
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
@ -1472,7 +1472,7 @@
;;; varbind pop-up-windows
;;; not
;;;
;;; we break the program, because it will appear that pop-up-windows and
;;; we break the program, because it will appear that pop-up-windows and
;;; old-pop-ups are not EQ when really they are. So we have to know what
;;; the BOOL variables are, and not perform this optimization on them.
@ -1619,7 +1619,7 @@
;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
;;
;; it is wrong to do the same thing for the -else-pop variants.
;;
;;
((and (or (eq 'byte-goto-if-nil (car lap0))
(eq 'byte-goto-if-not-nil (car lap0))) ; gotoX
(eq 'byte-goto (car lap1)) ; gotoY
@ -1722,7 +1722,7 @@
str (concat str " %s")
i (1+ i))))
(if opt-p
(let ((tagstr
(let ((tagstr
(if (eq 'TAG (car (car tmp)))
(format "%d:" (car (cdr (car tmp))))
(or (car tmp) ""))))
@ -1903,7 +1903,7 @@
(byte-goto-if-not-nil-else-pop .
byte-goto-if-nil-else-pop))))
newtag)
(nth 1 newtag)
)
(setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))

6
lisp/emacs-lisp/checkdoc.el
View file

@ -426,7 +426,7 @@ be re-created.")
;; end of a word in a conglomerate.
(modify-syntax-entry ?- "w" checkdoc-syntax-table)
)
;;; Compatibility
;;
@ -940,7 +940,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
(checkdoc-show-diagnostics)))
(goto-char p))
(if (interactive-p) (message "Checking interactive message text...done.")))
;;;###autoload
(defun checkdoc-eval-defun ()
"Evaluate the current form with `eval-defun' and check its documentation.
@ -2340,7 +2340,7 @@ The default boundary is the entire buffer."
(while (setq type (checkdoc-message-text-next-string end))
(setq e (checkdoc-message-text-engine type)))
e))
(defun checkdoc-message-text-next-string (end)
"Move cursor to the next checkable message string after point.
Return the message classification.

6
lisp/emacs-lisp/cl-indent.el
View file

@ -132,7 +132,7 @@ If nil, indent backquoted lists as data, i.e., like quoted lists."
(+ loop-indentation lisp-loop-keyword-indentation))
(t
(+ loop-indentation lisp-loop-forms-indentation)))))
;;;###autoload
(defun common-lisp-indent-function (indent-point state)
@ -140,8 +140,8 @@ If nil, indent backquoted lists as data, i.e., like quoted lists."
(looking-at "([Ll][Oo][Oo][Pp]"))
(common-lisp-loop-part-indentation indent-point state)
(common-lisp-indent-function-1 indent-point state)))
(defun common-lisp-indent-function-1 (indent-point state)
(let ((normal-indent (current-column)))
;; Walk up list levels until we see something

2
lisp/emacs-lisp/cl-macs.el
View file

@ -1368,7 +1368,7 @@ lexical closures as in Common Lisp."
(set (car cl-closure-vars) [bad-lexical-ref])
(list (car x) (cadr x) (car cl-closure-vars))))
bindings))
(ebody
(ebody
(cl-macroexpand-all
(cons 'progn body)
(nconc (mapcar (function (lambda (x)

88
lisp/emacs-lisp/cl-specs.el
View file

@ -7,7 +7,7 @@
;; LCD Archive Entry:
;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org
;; |Edebug specs for cl.el
;; |$Date: 2001/07/16 12:22:59 $|1.1|
;; |$Date: 2002/10/01 17:00:27 $|1.1|
;; This file is part of GNU Emacs.
@ -53,22 +53,22 @@
(def-edebug-spec ecase case)
(def-edebug-spec do
((&rest &or symbolp (symbolp &optional form form))
(form body)
(form body)
cl-declarations body))
(def-edebug-spec do* do)
(def-edebug-spec dolist
(def-edebug-spec dolist
((symbolp form &optional form) cl-declarations body))
(def-edebug-spec dotimes dolist)
(def-edebug-spec do-symbols
((symbolp &optional form form) cl-declarations body))
(def-edebug-spec do-all-symbols
(def-edebug-spec do-all-symbols
((symbolp &optional form) cl-declarations body))
;; Multiple values
(def-edebug-spec multiple-value-list (form))
(def-edebug-spec multiple-value-call (function-form body))
(def-edebug-spec multiple-value-bind
(def-edebug-spec multiple-value-bind
((&rest symbolp) form cl-declarations body))
(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
(def-edebug-spec multiple-value-prog1 (form body))
@ -84,11 +84,11 @@
(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
(def-edebug-spec labels flet)
(def-edebug-spec macrolet
((&rest (&define name (&rest arg) cl-declarations-or-string def-body))
(def-edebug-spec macrolet
((&rest (&define name (&rest arg) cl-declarations-or-string def-body))
cl-declarations body))
(def-edebug-spec symbol-macrolet
(def-edebug-spec symbol-macrolet
((&rest (symbol sexp)) cl-declarations body))
(def-edebug-spec destructuring-bind
@ -105,13 +105,13 @@
(def-edebug-spec letf* letf)
(def-edebug-spec defsetf
(&define name
(def-edebug-spec defsetf
(&define name
[&or [symbolp &optional stringp]
[cl-lambda-list (symbolp)]]
cl-declarations-or-string def-body))
(def-edebug-spec define-setf-method
(def-edebug-spec define-setf-method
(&define name cl-lambda-list cl-declarations-or-string def-body))
(def-edebug-spec define-modify-macro
@ -128,8 +128,8 @@
(def-edebug-spec incf (place &optional form))
(def-edebug-spec decf incf)
(def-edebug-spec push (form place)) ; different for CL
(def-edebug-spec pushnew
(form place &rest
(def-edebug-spec pushnew
(form place &rest
&or [[&or ":test" ":test-not" ":key"] function-form]
[edebug-keywordp form]))
(def-edebug-spec pop (place)) ; different for CL
@ -180,7 +180,7 @@
;; Declarations
(def-edebug-spec cl-decl-spec
(def-edebug-spec cl-decl-spec
((symbolp &rest sexp)))
(def-edebug-spec cl-declarations
@ -214,17 +214,17 @@
(&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
;; The lambda list for macros is different from that of normal lambdas.
;; Note that &environment is only allowed as first or last items in the
;; Note that &environment is only allowed as first or last items in the
;; top level list.
(def-edebug-spec cl-macro-list
(([&optional "&environment" arg]
[&rest cl-macro-arg]
[&optional ["&optional" &rest
[&optional ["&optional" &rest
&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
[&optional [[&or "&rest" "&body"] cl-macro-arg]]
[&optional ["&key" [&rest
[&or ([&or (symbolp cl-macro-arg) arg]
[&optional ["&key" [&rest
[&or ([&or (symbolp cl-macro-arg) arg]
&optional def-form cl-macro-arg)
arg]]
&optional "&allow-other-keys"]]
@ -239,11 +239,11 @@
(def-edebug-spec cl-macro-list1
(([&optional "&whole" arg] ;; only allowed at lower levels
[&rest cl-macro-arg]
[&optional ["&optional" &rest
[&optional ["&optional" &rest
&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
[&optional [[&or "&rest" "&body"] cl-macro-arg]]
[&optional ["&key" [&rest
[&or ([&or (symbolp cl-macro-arg) arg]
[&optional ["&key" [&rest
[&or ([&or (symbolp cl-macro-arg) arg]
&optional def-form cl-macro-arg)
arg]]
&optional "&allow-other-keys"]]
@ -262,7 +262,7 @@
def-body))
(def-edebug-spec defsubst* defun*)
(def-edebug-spec defmacro*
(def-edebug-spec defmacro*
(&define name cl-macro-list cl-declarations-or-string def-body))
(def-edebug-spec define-compiler-macro defmacro*)
@ -280,7 +280,7 @@
(def-edebug-spec function-form
;; form at the end could also handle "function",
;; but recognize it specially to avoid wrapping function forms.
(&or ([&or "quote" "function"] &or symbolp lambda-expr)
(&or ([&or "quote" "function"] &or symbolp lambda-expr)
("function*" function*)
form))
@ -293,7 +293,7 @@
(&define ; makes top-level form not be wrapped
[&or symbolp
(gate
symbolp &rest
symbolp &rest
(&or [":conc-name" &or stringp "nil"]
[":constructor" symbolp &optional cl-lambda-list]
[":copier" symbolp]
@ -329,7 +329,7 @@
(def-edebug-spec loop
([&optional ["named" symbolp]]
[&rest
[&rest
&or
["repeat" form]
loop-for-as
@ -351,36 +351,36 @@
&rest ["and" loop-for-as-subclause]))
(def-edebug-spec loop-for-as-subclause
(loop-var
(loop-var
loop-type-spec
&or
&or
[[&or "in" "on" "in-ref" "across-ref"]
form &optional ["by" function-form]]
["=" form &optional ["then" form]]
["across" form]
["being"
["being"
[&or "the" "each"]
&or
[[&or "element" "elements"]
&or
[[&or "element" "elements"]
[&or "of" "in" "of-ref"] form
&optional "using" ["index" symbolp]];; is this right?
[[&or "hash-key" "hash-keys"
"hash-value" "hash-values"]
[&or "of" "in"]
hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
"hash-key" "hash-keys"] sexp)]]
[[&or "symbol" "present-symbol" "external-symbol"
"symbols" "present-symbols" "external-symbols"]
[&or "in" "of"] package-p]
;; Extensions for Emacs Lisp, including Lucid Emacs.
[[&or "frame" "frames"
"screen" "screens"
"buffer" "buffers"]]
[[&or "window" "windows"]
[[&or "window" "windows"]
[&or "of" "in"] form]
[[&or "overlay" "overlays"
@ -388,23 +388,23 @@
[&or "of" "in"] form
&optional [[&or "from" "to"] form]]
[[&or "interval" "intervals"]
[[&or "interval" "intervals"]
[&or "in" "of"] form
&optional [[&or "from" "to"] form]
["property" form]]
[[&or "key-code" "key-codes"
"key-seq" "key-seqs"
"key-binding" "key-bindings"]
"key-binding" "key-bindings"]
[&or "in" "of"] form
&optional ["using" ([&or "key-code" "key-codes"
"key-seq" "key-seqs"
"key-binding" "key-bindings"]
"key-binding" "key-bindings"]
sexp)]]
;; For arbitrary extensions, recognize anything else.
[symbolp &rest &or symbolp form]
]
;; arithmetic - must be last since all parts are optional.
[[&optional [[&or "from" "downfrom" "upfrom"] form]]
[&optional [[&or "to" "downto" "upto" "below" "above"] form]]
@ -412,10 +412,10 @@
]))
(def-edebug-spec loop-initial-final
(&or ["initially"
(&or ["initially"
;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
&rest loop-non-atomic-expr]
["finally" &or
["finally" &or
[[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
["return" form]]))
@ -425,11 +425,11 @@
(def-edebug-spec loop-clause
(&or
[[&or "while" "until" "always" "never" "thereis"] form]
[[&or "collect" "collecting"
"append" "appending"
"nconc" "nconcing"
"concat" "vconcat"] form
"concat" "vconcat"] form
[&optional ["into" loop-var]]]
[[&or "count" "counting"
@ -455,7 +455,7 @@
(def-edebug-spec loop-var
;; The symbolp must be last alternative to recognize e.g. (a b . c)
;; loop-var =>
;; loop-var =>
;; (loop-var . [&or nil loop-var])
;; (symbolp . [&or nil loop-var])
;; (symbolp . loop-var)

38
lisp/emacs-lisp/crm.el
View file

@ -85,7 +85,7 @@
;; -tip: use M-f and M-b for ease of navigation among elements.
;;; History:
;;
;;
;; 2000-04-10:
;;
;; first revamped version
@ -211,7 +211,7 @@ and return t."
;; no candidate found
nil
(progn
;;
;;
(setq crm-beginning-of-element (match-beginning 1))
(setq crm-end-of-element end-index)
;; string to the left of the current element
@ -226,7 +226,7 @@ and return t."
"Return t if CANDIDATE is an exact match for a valid completion."
(let ((completions
;; TODO: verify whether the arguments are appropriate
(all-completions
(all-completions
candidate crm-completion-table minibuffer-completion-predicate)))
(if (member candidate completions)
t
@ -271,20 +271,20 @@ The meanings of the return values are:
minibuffer-completion-predicate))
(setq last crm-last-exact-completion)
(setq crm-last-exact-completion nil)
(catch 'crm-exit
(if (null completion) ; no possible completion
(progn
(crm-temp-echo-area-glyphs " [No match]")
(throw 'crm-exit 0)))
(if (eq completion t) ; was already an exact and unique completion
(throw 'crm-exit 1))
(setq completedp
(null (string-equal completion crm-current-element)))
(if completedp
(progn
(erase-buffer)
@ -295,7 +295,7 @@ The meanings of the return values are:
(backward-char (length crm-right-of-element))
;; TODO: is this correct?
(setq crm-current-element completion)))
(if (null (crm-test-completion crm-current-element))
(progn
(if completedp ; some completion happened
@ -306,13 +306,13 @@ The meanings of the return values are:
(throw 'crm-exit 6))
(if completedp
(throw 'crm-exit 4)))
(setq crm-last-exact-completion completion)
(if (not (null last))
(progn
(if (not (null (equal crm-current-element last)))
(crm-minibuffer-completion-help))))
;; returning -- was already an exact completion
(throw 'crm-exit 3)))))
@ -472,24 +472,24 @@ to the location of mismatch and do not exit.
This function is modeled after `minibuffer_complete_and_exit' in src/minibuf.c"
(interactive)
(if (not (crm-find-current-element))
nil
(let (result)
(setq result
(catch 'crm-exit
(if (eq (point-min) (point-max))
(throw 'crm-exit t))
;; TODO: this test is suspect?
(if (not (null (crm-test-completion crm-current-element)))
(throw 'crm-exit "check"))
;; TODO: determine how to detect errors
(let ((result (crm-do-completion)))
(cond
((or (eq 1 result)
(eq 3 result))
@ -501,7 +501,7 @@ This function is modeled after `minibuffer_complete_and_exit' in src/minibuf.c"
nil)
(throw 'crm-exit "check")))
(nil)))))
(if (null result)
nil
(if (equal result "check")
@ -541,7 +541,7 @@ and TAB to `crm-minibuffer-complete'."
(define-key crm-local-completion-map
(kbd "TAB")
(function crm-minibuffer-complete)))
(unless crm-local-must-match-map
(setq crm-local-must-match-map (make-sparse-keymap))
(set-keymap-parent crm-local-must-match-map

44
lisp/emacs-lisp/cust-print.el
View file

@ -34,7 +34,7 @@
;; print-length since the standard routines are being replaced. Also,
;; to print custom types constructed from lists and vectors, use
;; custom-print-list and custom-print-vector. See the documentation
;; strings of these variables for more details.
;; strings of these variables for more details.
;; If the results of your expressions contain circular references to
;; other parts of the same structure, the standard Emacs print
@ -131,7 +131,7 @@
;;This is defined by emacs.")
(defcustom print-level nil
"*Controls how many levels deep a nested data object will print.
"*Controls how many levels deep a nested data object will print.
If nil, printing proceeds recursively and may lead to
max-lisp-eval-depth being exceeded or an error may occur:
@ -147,7 +147,7 @@ level 1."
(defcustom print-circle nil
"*Controls the printing of recursive structures.
"*Controls the printing of recursive structures.
If nil, printing proceeds recursively and may lead to
`max-lisp-eval-depth' being exceeded or an error may occur:
@ -196,7 +196,7 @@ Don't modify this variable directly. Use `add-custom-printer' and
(defun add-custom-printer (pred printer)
"Add a pair of PREDICATE and PRINTER to `custom-printers'.
Any pair that has the same PREDICATE is first removed."
(setq custom-printers (cons (cons pred printer)
(setq custom-printers (cons (cons pred printer)
(delq (assq pred custom-printers)
custom-printers)))
;; Rather than updating here, we could wait until cust-print-top-level is called.
@ -220,9 +220,9 @@ Any pair that has the same PREDICATE is first removed."
;; (byte-compile
`(lambda (object)
(cond
,@(mapcar (function
,@(mapcar (function
(lambda (pair)
`((,(car pair) object)
`((,(car pair) object)
(,(cdr pair) object))))
custom-printers)
;; Otherwise return nil.
@ -236,7 +236,7 @@ Any pair that has the same PREDICATE is first removed."
;;====================================================
(defun cust-print-set-function-cell (symbol-pair)
(defalias (car symbol-pair)
(defalias (car symbol-pair)
(symbol-function (car (cdr symbol-pair)))))
(defun cust-print-original-princ (object &optional stream)) ; dummy def
@ -268,7 +268,7 @@ by running `custom-print-uninstall'."
(error custom-error)
))
t)
(defun custom-print-uninstall ()
"Reset print functions to their emacs subroutines."
(interactive)
@ -335,7 +335,7 @@ second argument NOESCAPE is non-nil.
This is the custom-print replacement for the standard `prin1-to-string'."
(let ((buf (get-buffer-create " *custom-print-temp*")))
;; We must erase the buffer before printing in case an error
;; We must erase the buffer before printing in case an error
;; occurred during the last prin1-to-string and we are in debugger.
(save-excursion
(set-buffer buf)
@ -364,7 +364,7 @@ This is the custom-print replacement for the standard `print'."
(defun custom-format (fmt &rest args)
"Format a string out of a control-string and arguments.
"Format a string out of a control-string and arguments.
The first argument is a control string. It, and subsequent arguments
substituted into it, become the value, which is a string.
It may contain %s or %d or %c to substitute successive following arguments.
@ -385,8 +385,8 @@ characters."
(custom-prin1-to-string arg)
arg)))
args)))
(defun custom-message (fmt &rest args)
"Print a one-line message at the bottom of the screen.
The first argument is a control string.
@ -401,7 +401,7 @@ See `custom-format' for the details."
;; It doesn't work to princ the result of custom-format as in:
;; (cust-print-original-princ (apply 'custom-format fmt args))
;; because the echo area requires special handling
;; to avoid duplicating the output.
;; to avoid duplicating the output.
;; cust-print-original-message does it right.
(apply 'cust-print-original-message fmt
(mapcar (function (lambda (arg)
@ -409,7 +409,7 @@ See `custom-format' for the details."
(custom-prin1-to-string arg)
arg)))
args)))
(defun custom-error (fmt &rest args)
"Signal an error, making error message by passing all args to `format'.
@ -435,12 +435,12 @@ See `custom-format' for the details."
;; Set up for printing.
(let ((standard-output (or stream standard-output))
;; circle-table will be non-nil if anything is circular.
(circle-table (and print-circle
(circle-table (and print-circle
(cust-print-preprocess-circle-tree object)))
(cust-print-current-level (or print-level -1)))
(defalias 'cust-print-original-printer emacs-printer)
(defalias 'cust-print-low-level-prin
(defalias 'cust-print-low-level-prin
(cond
((or custom-printers
circle-table
@ -451,7 +451,7 @@ See `custom-format' for the details."
(or print-level print-length)))
'cust-print-print-object)
(t 'cust-print-original-printer)))
(defalias 'cust-print-prin
(defalias 'cust-print-prin
(if circle-table 'cust-print-print-circular 'cust-print-low-level-prin))
(cust-print-prin object)
@ -461,7 +461,7 @@ See `custom-format' for the details."
(defun cust-print-print-object (object)
;; Test object type and print accordingly.
;; Could be called as either cust-print-low-level-prin or cust-print-prin.
(cond
(cond
((null object) (cust-print-original-printer object))
((cust-print-use-custom-printer object) object)
((consp object) (cust-print-list object))
@ -561,7 +561,7 @@ See `custom-format' for the details."
;;==================================
(defun cust-print-preprocess-circle-tree (object)
;; Fill up the table.
;; Fill up the table.
(let (;; Table of tags for each object in an object to be printed.
;; A tag is of the form:
;; ( <object> <nil-t-or-id-number> )
@ -600,8 +600,8 @@ See `custom-format' for the details."
(defun cust-print-walk-circle-tree (object)
(let (read-equivalent-p tag)
(while object
(setq read-equivalent-p
(or (numberp object)
(setq read-equivalent-p
(or (numberp object)
(and (symbolp object)
;; Check if it is uninterned.
(eq object (intern-soft (symbol-name object)))))
@ -617,7 +617,7 @@ See `custom-format' for the details."
(cons (list object)
(cdr circle-table)))))
(setq object
(cond
(cond
(tag ;; No need to descend since we have already.
nil)

2
lisp/emacs-lisp/debug.el
View file

@ -338,7 +338,7 @@ That buffer should be current already."
;; Make the unchanged part of the backtrace inaccessible
;; so it won't be scanned.
(narrow-to-region (point-min) new-end)))
;; Scan the new part of the backtrace, inserting xrefs.
(goto-char (point-min))
(while (progn

2
lisp/emacs-lisp/disass.el
View file

@ -88,7 +88,7 @@ redefine OBJECT if it is a symbol."
(setq macro t
obj (cdr obj)))
(if (and (listp obj) (eq (car obj) 'byte-code))
(setq obj (list 'lambda nil obj)))
(setq obj (list 'lambda nil obj)))
(if (and (listp obj) (not (eq (car obj) 'lambda)))
(error "not a function"))
(if (consp obj)

2
lisp/emacs-lisp/easy-mmode.el
View file

@ -228,7 +228,7 @@ With zero or negative ARG turn mode off.
,(if keymap keymap-sym
`(if (boundp ',keymap-sym)
(symbol-value ',keymap-sym))))
;; If the mode is global, call the function according to the default.
,(if globalp
`(if (and load-file-name (not (equal ,init-value ,mode)))

400
lisp/emacs-lisp/edebug.el
View file

File diff suppressed because it is too large Load diff

10
lisp/emacs-lisp/ewoc.el
View file

@ -92,7 +92,7 @@
;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help
;; you find all the exported functions:
;;
;;
;; (defun ewoc-create (pretty-printer &optional header footer)
;; (defalias 'ewoc-data 'ewoc--node-data)
;; (defun ewoc-location (node)
@ -394,8 +394,8 @@ MAP-FUNCTION is applied to the first element first.
If MAP-FUNCTION returns non-nil the element will be refreshed (its
pretty-printer will be called once again).
Note that the buffer for EWOC will be current buffer when MAP-FUNCTION
is called. MAP-FUNCTION must restore the current buffer to BUFFER before
Note that the buffer for EWOC will be current buffer when MAP-FUNCTION
is called. MAP-FUNCTION must restore the current buffer to BUFFER before
it returns, if it changes it.
If more than two arguments are given, the remaining
@ -410,7 +410,7 @@ arguments will be passed to MAP-FUNCTION."
(defun ewoc-filter (ewoc predicate &rest args)
"Remove all elements in EWOC for which PREDICATE returns nil.
Note that the buffer for EWOC will be current-buffer when PREDICATE
Note that the buffer for EWOC will be current-buffer when PREDICATE
is called. PREDICATE must restore the current buffer before it returns
if it changes it.
The PREDICATE is called with the element as its first argument. If any
@ -478,7 +478,7 @@ If the EWOC is empty, nil is returned."
;; best-guess is now a "best guess".
;; Find the correct node. First determine in which direction
;; it lies, and then move in that direction until it is found.
(cond
;; Is pos after the guess?
((>= pos

2
lisp/emacs-lisp/find-func.el
View file

@ -312,7 +312,7 @@ The library where VARIABLE is defined is searched for in FILE or
`find-function-source-path', if non nil, otherwise in `load-path'."
(if (not variable)
(error "You didn't specify a variable"))
;; Fixme: I think `symbol-file' should be fixed instead. -- fx
;; Fixme: I think `symbol-file' should be fixed instead. -- fx
(let ((library (or file (symbol-file (cons 'defvar variable)))))
(find-function-search-for-symbol variable 'variable library)))

2
lisp/emacs-lisp/gulp.el
View file

@ -103,7 +103,7 @@ is left in the `*gulp*' buffer at the end."
(while (setq node (car m-p-alist))
(setq msg (gulp-create-message (cdr node) time))
(setq mail-setup-hook
(lambda ()
(lambda ()
(mail-subject)
(insert "It's time for Emacs updates again")
(goto-char (point-max))

12
lisp/emacs-lisp/levents.el
View file

@ -98,8 +98,8 @@ in is the second. This function contains knowledge about what the codes
mean -- for example, the number 9 is converted to the character Tab,
not the distinct character Control-I.
Beware that character-to-event and event-to-character are not strictly
inverse functions, since events contain much more information than the
Beware that character-to-event and event-to-character are not strictly
inverse functions, since events contain much more information than the
ASCII character set can encode."
ch)
@ -214,11 +214,11 @@ In this emulation, it returns nil for non-mouse-related events."
(defun event-to-character (event &optional lenient)
"Returns the closest ASCII approximation to the given event object.
If the event isn't a keypress, this returns nil.
If the second argument is non-nil, then this is lenient in its
If the second argument is non-nil, then this is lenient in its
translation; it will ignore modifier keys other than control and meta,
and will ignore the shift modifier on those characters which have no
shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
the same ASCII code as Control-A.) If the second arg is nil, then nil
and will ignore the shift modifier on those characters which have no
shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
the same ASCII code as Control-A.) If the second arg is nil, then nil
will be returned for events which have no direct ASCII equivalent."
(if (symbolp event)
(and lenient

30
lisp/emacs-lisp/lisp-mnt.el
View file

@ -32,7 +32,7 @@
;; First, it knows about the header conventions for library packages.
;; One entry point supports generating synopses from a library directory.
;; Another can be used to check for missing headers in library files.
;;
;;
;; Another entry point automatically addresses bug mail to a package's
;; maintainer or author.
@ -40,11 +40,11 @@
;; This file is an example of the header conventions. Note the following
;; features:
;;
;;
;; * Header line --- makes it possible to extract a one-line summary of
;; the package's uses automatically for use in library synopses, KWIC
;; indexes and the like.
;;
;;
;; Format is three semicolons, followed by the filename, followed by
;; three dashes, followed by the summary. All fields space-separated.
;;
@ -55,13 +55,13 @@
;; ;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
;;
;; * A blank line
;;
;;
;; * Author line --- contains the name and net address of at least
;; the principal author.
;;
;;
;; If there are multiple authors, they should be listed on continuation
;; lines led by ;;<TAB>, like this:
;;
;;
;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
;; ;; Dave Sill <de5@ornl.gov>
;; ;; David Lawrence <tale@pawl.rpi.edu>
@ -69,10 +69,10 @@
;; ;; Joe Wells <jbw@maverick.uswest.com>
;; ;; Dave Brennan <brennan@hal.com>
;; ;; Eric Raymond <esr@snark.thyrsus.com>
;;
;;
;; This field may have some special values; notably "FSF", meaning
;; "Free Software Foundation".
;;
;;
;; * Maintainer line --- should be a single name/address as in the Author
;; line, or an address only, or the string "FSF". If there is no maintainer
;; line, the person(s) in the Author field are presumed to be it. The example
@ -81,19 +81,19 @@
;; that does "send mail to the author" without having to mine the name out by
;; hand. Please be careful about surrounding the network address with <> if
;; there's also a name in the field.
;;
;;
;; * Created line --- optional, gives the original creation date of the
;; file. For historical interest, basically.
;;
;;
;; * Version line --- intended to give the reader a clue if they're looking
;; at a different version of the file than the one they're accustomed to. This
;; may be an RCS or SCCS header.
;;
;;
;; * Adapted-By line --- this is for FSF's internal use. The person named
;; in this field was the one responsible for installing and adapting the
;; package for the distribution. (This file doesn't have one because the
;; author *is* one of the maintainers.)
;;
;;
;; * Keywords line --- used by the finder code (now under construction)
;; for finding Emacs Lisp code related to a topic.
;;
@ -104,13 +104,13 @@
;;
;; * Commentary line --- enables Lisp code to find the developer's and
;; maintainers' explanations of the package internals.
;;
;;
;; * Change log line --- optional, exists to terminate the commentary
;; section and start a change-log part, if one exists.
;;
;;
;; * Code line --- exists so Lisp can know where commentary and/or
;; change-log sections end.
;;
;;
;; * Footer line --- marks end-of-file so it can be distinguished from
;; an expanded formfeed or the results of truncation.

10
lisp/emacs-lisp/lisp-mode.el
View file

@ -403,16 +403,16 @@ which see."
(defun last-sexp-setup-props (beg end value alt1 alt2)
"Set up text properties for the output of `eval-last-sexp-1'.
BEG and END are the start and end of the output in current-buffer.
VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
alternative printed representations that can be displayed."
(let ((map (make-sparse-keymap)))
(define-key map "\C-m" 'last-sexp-toggle-display)
(define-key map [down-mouse-2] 'mouse-set-point)
(define-key map [mouse-2] 'last-sexp-toggle-display)
(add-text-properties
beg end
beg end
`(printed-value (,value ,alt1 ,alt2)
mouse-face highlight
mouse-face highlight
keymap ,map
help-echo "RET, mouse-2: toggle abbreviated display"
rear-nonsticky (mouse-face keymap help-echo
@ -430,7 +430,7 @@ alternative printed representations that can be displayed."
(point (point)))
(delete-region beg end)
(insert (nth 1 value))
(last-sexp-setup-props beg (point)
(last-sexp-setup-props beg (point)
(nth 0 value)
(nth 2 value)
(nth 1 value))
@ -508,7 +508,7 @@ With argument, print output into current buffer."
(not (null print-level)))
(not (string= unabbreviated
(buffer-substring-no-properties beg end))))
(last-sexp-setup-props beg end value
(last-sexp-setup-props beg end value
unabbreviated
(buffer-substring-no-properties beg end))
))))))

2
lisp/emacs-lisp/pp.el
View file

@ -31,7 +31,7 @@
:prefix "pp-"
:group 'lisp)
(defcustom pp-escape-newlines t
(defcustom pp-escape-newlines t
"*Value of `print-escape-newlines' used by pp-* functions."
:type 'boolean
:group 'pp)

2
lisp/emacs-lisp/re-builder.el
View file

@ -269,7 +269,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(define-key reb-lisp-mode-map "\C-c"
(lookup-key reb-mode-map "\C-c"))
(defvar reb-subexp-mode-map
(defvar reb-subexp-mode-map
(let ((m (make-keymap)))
(suppress-keymap m)
;; Again share the "\C-c" keymap for the commands

2
lisp/emacs-lisp/regexp-opt.el
View file

@ -218,7 +218,7 @@ in REGEXP."
(regexp-quote
(concat (nreverse (string-to-list xiffus))))
close-group))
;; Otherwise, divide the list into those that start with a
;; particular letter and those that do not, and recurse on them.
(let* ((char (char-to-string (string-to-char (car strings))))

20
lisp/emacs-lisp/rx.el
View file

@ -78,8 +78,8 @@
;; (and line-start ?\n)))
;;
;; "\\$[I]d: [^ ]+ \\([^ ]+\\) "
;; (rx (and "$Id: "
;; (1+ (not (in " ")))
;; (rx (and "$Id: "
;; (1+ (not (in " ")))
;; " "
;; (submatch (1+ (not (in " "))))
;; " "))
@ -90,7 +90,7 @@
;; etc.
;;; History:
;;
;;
;;; Code:
@ -244,7 +244,7 @@ See also `rx-constituents'."
(while (and (not (null op)) (symbolp op))
(setq op (cdr (assq op rx-constituents))))
op)
(defun rx-check (form)
"Check FORM according to its car's parsing info."
@ -396,7 +396,7 @@ FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'."
(defun rx-kleene (form)
"Parse and produce code from FORM.
FORM is `(OP FORM1)', where OP is one of the `zero-or-one',
`zero-or-more' etc. operators.
`zero-or-more' etc. operators.
If OP is one of `*', `+', `?', produce a greedy regexp.
If OP is one of `*?', `+?', `??', produce a non-greedy regexp.
If OP is anything else, produce a greedy regexp if `rx-greedy-flag'
@ -463,7 +463,7 @@ of all atomic regexps."
(cdr (assq form rx-categories)))
(error "Unknown category `%s'" form))
t)
(defun rx-category (form)
"Parse and produce code from FORM, which is `(category SYMBOL ...)'."
@ -511,7 +511,7 @@ NO-GROUP non-nil means don't put shy groups around the result."
info)
((null info)
(error "Unknown Rx form `%s'" form))
(t
(t
(funcall (nth 0 info) form)))))
((consp form)
(let ((info (rx-info (car form))))
@ -549,7 +549,7 @@ CHAR
matches any character in SET. SET may be a character or string.
Ranges of characters can be specified as `A-Z' in strings.
'(in SET)'
'(in SET)'
like `any'.
`(not (any SET))'
@ -751,7 +751,7 @@ CHAR
`(one-or-more SEXP)'
matches one or more occurrences of A.
`(1+ SEXP)'
like `one-or-more'.
@ -763,7 +763,7 @@ CHAR
`(zero-or-one SEXP)'
matches zero or one occurrences of A.
`(optional SEXP)'
like `zero-or-one'.

8
lisp/emacs-lisp/shadow.el
View file

@ -74,7 +74,7 @@ the file in position 2i+1. Emacs Lisp file suffixes \(.el and .elc\)
are stripped from the file names in the list.
See the documentation for `list-load-path-shadows' for further information."
(or path (setq path load-path))
(let (true-names ; List of dirs considered.
@ -86,7 +86,7 @@ See the documentation for `list-load-path-shadows' for further information."
files-seen-this-dir ; Files seen so far in this dir.
file) ; The current file.
(while path
(setq dir (directory-file-name (file-truename (or (car path) "."))))
@ -125,7 +125,7 @@ See the documentation for `list-load-path-shadows' for further information."
;; This test prevents us declaring that XXX.el shadows
;; XXX.elc (or vice-versa) when they are in the same directory.
(setq files-seen-this-dir (cons file files-seen-this-dir))
(if (setq orig-dir (assoc file files))
;; This file was seen before, we have a shadowing.
;; Report it unless the files are identical.
@ -202,7 +202,7 @@ considered to shadow a later file XXX.el, and vice-versa.
When run interactively, the shadowings \(if any\) are displayed in a
buffer called `*Shadows*'. Shadowings are located by calling the
\(non-interactive\) companion function, `find-emacs-lisp-shadows'."
(interactive)
(let* ((path (copy-sequence load-path))
(tem path)

6
lisp/emacs-lisp/syntax.el
View file

@ -113,7 +113,7 @@ avoid a more expansive scan.
Point is at POS when this function returns."
;; Default values.
(unless pos (setq pos (point)))
;;
;;
(let ((old-ppss (cdr syntax-ppss-last))
(old-pos (car syntax-ppss-last))
(ppss nil)
@ -129,7 +129,7 @@ Point is at POS when this function returns."
(incf (car (aref syntax-ppss-stats 0)))
(incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
(parse-partial-sexp old-pos pos nil nil old-ppss))
(cond
;; Use OLD-PPSS if possible and close enough.
((and (not old-pos) old-ppss
@ -253,7 +253,7 @@ Point is at POS when this function returns."
syntax-ppss-max-span))
(push pair syntax-ppss-cache)
(setcar syntax-ppss-cache pair)))))))))
(setq syntax-ppss-last (cons pos ppss))
ppss)))

4
lisp/emacs-lisp/tq.el
View file

@ -25,7 +25,7 @@
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; manages receiving a stream asynchronously,
;; parsing it into transactions, and then calling
;; handler functions
@ -68,7 +68,7 @@ to a tcp server on another machine."
(defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
(defun tq-queue-empty (tq) (not (tq-queue tq)))
(defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq)))
;;; must add to queue before sending!
(defun tq-enqueue (tq question regexp closure fn)

2
lisp/emacs-lisp/unsafep.el
View file

@ -212,7 +212,7 @@ of symbols with local bindings."
(defun unsafep-function (fun)
"Return nil if FUN is a safe function
\(either a safe lambda or a symbol that names a safe function). Otherwise
result is a reason code."
result is a reason code."
(cond
((eq (car-safe fun) 'lambda)
(unsafep fun unsafep-vars))

2
lisp/emulation/crisp.el
View file

@ -338,7 +338,7 @@ consecutive use moves point to the end of the buffer."
"Go back one buffer."
(interactive)
(switch-to-buffer (car (last (buffer-list)))))
(defun crisp-meta-x-wrapper ()
"Wrapper function to conditionally override the normal M-x bindings.
When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the

64
lisp/emulation/cua-base.el
View file

@ -54,7 +54,7 @@
;; This probably sounds strange and difficult to get used to - but
;; based on my own experience and the feedback from many users of
;; this package, it actually works very well and users adapt to it
;; instantly - or at least very quickly. So give it a try!
;; instantly - or at least very quickly. So give it a try!
;; ... and in the few cases where you make a mistake and accidentally
;; delete the region - you just undo the mistake (with C-z).
;;
@ -120,15 +120,15 @@
;; --------------------
;; Emacs' standard register support is also based on a separate set of
;; "register commands".
;;
;;
;; CUA's register support is activated by providing a numeric
;; prefix argument to the C-x, C-c, and C-v commands. For example,
;; to copy the selected region to register 2, enter [M-2 C-c].
;; Or if you have activated the keypad prefix mode, enter [kp-2 C-c].
;;
;;
;; And CUA will copy and paste normal region as well as rectangles
;; into the registers, i.e. you use exactly the same command for both.
;;
;;
;; In addition, the last highlighted text that is deleted (not
;; copied), e.g. by [delete] or by typing text over a highlighted
;; region, is automatically saved in register 0, so you can insert it
@ -140,7 +140,7 @@
;; between the mark and point as a "virtual rectangle", and using a
;; completely separate set of "rectangle commands" [C-x r ...] on the
;; region to copy, kill, fill a.s.o. the virtual rectangle.
;;
;;
;; cua-mode's superior rectangle support is based on using a true visual
;; representation of the selected rectangle. To start a rectangle, use
;; [S-return] and extend it using the normal movement keys (up, down,
@ -154,12 +154,12 @@
;; the rectangle is inserted into the existing lines in the buffer.
;; If overwrite-mode is active when you paste a rectangle, it is
;; inserted as normal (multi-line) text.
;;
;;
;; Furthermore, cua-mode's rectangles are not limited to the actual
;; contents of the buffer, so if the cursor is currently at the end of a
;; short line, you can still extend the rectangle to include more columns
;; of longer lines in the same rectangle. Sounds strange? Try it!
;;
;;
;; You can enable padding for just this rectangle by pressing [M-p];
;; this works like entering `picture-mode' where the tabs and spaces
;; are automatically converted/inserted to make the rectangle truly
@ -185,7 +185,7 @@
;; paragraph like this one, just place the cursor on the first character
;; of the first line, and enter the following:
;; S-return M-} ; ; <space> S-return
;; cua-mode's rectangle support also includes all the normal rectangle
;; functions with easy access:
;;
@ -202,7 +202,7 @@
;; [M-m] copies the rectangle as normal multi-line text (for paste)
;; [M-n] fills each line of the rectangle with increasing numbers using
;; a supplied format string (prompt)
;; [M-o] opens the rectangle by moving the highlighted text to the
;; [M-o] opens the rectangle by moving the highlighted text to the
;; right of the rectangle and filling the rectangle with blanks.
;; [M-p] toggles rectangle padding, i.e. insert tabs and spaces to
;; make rectangles truly rectangular
@ -222,14 +222,14 @@
;; are lost, but can be recovered using [C-z].
;; CUA Global Mark
;; ---------------
;; ---------------
;; The final feature provided by CUA is the "global mark", which
;; makes it very easy to copy bits and pieces from the same and other
;; files into the current text. To enable and cancel the global mark,
;; use [S-C-space]. The cursor will blink when the global mark
;; is active. The following commands behave differently when the global
;; mark is set:
;; <ch> All characters (including newlines) you type are inserted
;; <ch> All characters (including newlines) you type are inserted
;; at the global mark!
;; [C-x] If you cut a region or rectangle, it is automatically inserted
;; at the global mark, and the global mark is advanced.
@ -289,7 +289,7 @@ If the value is t, these mappings are always enabled. If the value is
'shift, these keys are only enabled if the last region was marked with
a shifted movement key. If the value is nil, these keys are never
enabled."
:type '(choice (const :tag "Disabled" nil)
:type '(choice (const :tag "Disabled" nil)
(const :tag "Shift region only" shift)
(other :tag "Enabled" t))
:group 'cua)
@ -303,7 +303,7 @@ is not turned on."
:type 'boolean
:group 'cua)
(defcustom cua-prefix-override-inhibit-delay
(defcustom cua-prefix-override-inhibit-delay
(if (featurep 'lisp-float-type) (/ (float 1) (float 5)) nil)
"*If non-nil, time in seconds to delay before overriding prefix key.
If there is additional input within this time, the prefix key is
@ -325,12 +325,12 @@ If the value is nil, use a shifted prefix key to inhibit the override."
(defcustom cua-enable-register-prefix 'not-ctrl-u
"*If non-nil, registers are supported via numeric prefix arg.
If the value is t, any numeric prefix arg in the range 0 to 9 will be
interpreted as a register number.
interpreted as a register number.
If the value is not-ctrl-u, using C-u to enter a numeric prefix is not
interpreted as a register number.
interpreted as a register number.
If the value is ctrl-u-only, only numeric prefix entered with C-u is
interpreted as a register number."
:type '(choice (const :tag "Disabled" nil)
:type '(choice (const :tag "Disabled" nil)
(const :tag "Enabled, but C-u arg is not a register" not-ctrl-u)
(const :tag "Enabled, but only for C-u arg" ctrl-u-only)
(other :tag "Enabled" t))
@ -404,7 +404,7 @@ Can be toggled by [M-p] while the rectangle is active,"
:type 'boolean
:group 'cua)
(defface cua-global-mark-face '((((class color))
(defface cua-global-mark-face '((((class color))
(:foreground "black")
(:background "yellow"))
(t (:bold t)))
@ -576,7 +576,7 @@ Will change cursor color to specified color if string."
(not (numberp cua-prefix-override-inhibit-delay))
(<= cua-prefix-override-inhibit-delay 0)
;; In state [1], start [T] and change to state [2]
(run-with-timer cua-prefix-override-inhibit-delay nil
(run-with-timer cua-prefix-override-inhibit-delay nil
'cua--prefix-override-timeout)))
;; Don't record this command
(setq this-command last-command)
@ -604,7 +604,7 @@ Repeating prefix key when region is active works as a single prefix key."
(cua-copy-rectangle arg)
(cua-copy-region arg))
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
(defun cua--prefix-cut-handler (arg)
@ -614,7 +614,7 @@ Repeating prefix key when region is active works as a single prefix key."
(cua-cut-rectangle arg)
(cua-cut-region arg))
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
(defun cua--prefix-override-timeout ()
@ -633,7 +633,7 @@ Repeating prefix key when region is active works as a single prefix key."
;; Execute original command
(setq this-command this-original-command)
(call-interactively this-command))
(defun cua--keep-active ()
(setq mark-active t
deactivate-mark nil))
@ -650,13 +650,13 @@ Repeating prefix key when region is active works as a single prefix key."
(defvar cua--register nil)
(defun cua--prefix-arg (arg)
(setq cua--register
(setq cua--register
(and cua-enable-register-prefix
(integerp arg) (>= arg 0) (< arg 10)
(let* ((prefix (aref (this-command-keys) 0))
(ctrl-u-prefix (and (integerp prefix)
(= prefix ?\C-u))))
(cond
(cond
((eq cua-enable-register-prefix 'not-ctrl-u)
(not ctrl-u-prefix))
((eq cua-enable-register-prefix 'ctrl-u-only)
@ -691,7 +691,7 @@ Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
(if cua-delete-copy-to-register-0
(set-register ?0 cua--last-deleted-region-text))
(delete-region start end)
(setq cua--last-deleted-region-pos
(setq cua--last-deleted-region-pos
(cons (current-buffer)
(and (consp buffer-undo-list)
(car buffer-undo-list))))
@ -861,7 +861,7 @@ of text."
(defun cua-help-for-region (&optional help)
"Show region specific help in echo area."
(interactive)
(message
(message
(concat (if help "C-?:help " "")
"C-z:undo C-x:cut C-c:copy C-v:paste S-ret:rect")))
@ -959,7 +959,7 @@ Extra commands should be added to `cua-user-movement-commands'")
(unless mark-active
(push-mark-command nil nil)))
(t
;; If we set mark-active to nil here, the region highlight will not be
;; If we set mark-active to nil here, the region highlight will not be
;; removed by the direct_output_ commands.
(setq deactivate-mark t)))
@ -969,7 +969,7 @@ Extra commands should be added to `cua-user-movement-commands'")
(get this-command 'pending-delete)))
(nc (cond
((not ds) nil)
((eq ds 'yank)
((eq ds 'yank)
'cua-paste)
((eq ds 'kill)
(if cua--rectangle
@ -986,9 +986,9 @@ Extra commands should be added to `cua-user-movement-commands'")
(if nc
(setq this-original-command this-command
this-command nc)))))
;; Detect extension of rectangles by mouse or other movement
(setq cua--buffer-and-point-before-command
(setq cua--buffer-and-point-before-command
(if cua--rectangle (cons (current-buffer) (point))))
)
(error nil)))
@ -1008,7 +1008,7 @@ Extra commands should be added to `cua-user-movement-commands'")
;; Debugging
(if cua--debug
(cond
(cond
(cua--rectangle (cua--rectangle-assert))
(mark-active (message "Mark=%d Point=%d Expl=%s"
(mark t) (point) cua--explicit-region-start))))
@ -1123,7 +1123,7 @@ Extra commands should be added to `cua-user-movement-commands'")
(define-key cua--prefix-override-keymap [(control x)] 'cua--prefix-override-handler)
(define-key cua--prefix-override-keymap [(control c)] 'cua--prefix-override-handler)
(define-key cua--prefix-repeat-keymap [(control x) (control x)] 'cua--prefix-repeat-handler)
(define-key cua--prefix-repeat-keymap [(control x) up] 'cua--prefix-cut-handler)
(define-key cua--prefix-repeat-keymap [(control x) down] 'cua--prefix-cut-handler)
@ -1135,7 +1135,7 @@ Extra commands should be added to `cua-user-movement-commands'")
(define-key cua--prefix-repeat-keymap [(control c) left] 'cua--prefix-copy-handler)
(define-key cua--prefix-repeat-keymap [(control c) right] 'cua--prefix-copy-handler)
;; Enable shifted fallbacks for C-x and C-c when region is active
;; Enable shifted fallbacks for C-x and C-c when region is active
(define-key cua--region-keymap [(shift control x)] 'Control-X-prefix)
(define-key cua--region-keymap [(shift control c)] 'mode-specific-command-prefix)
;; replace current region

10
lisp/emulation/cua-gmrk.el
View file

@ -33,7 +33,7 @@
(require 'cua-rect)
)
;;; Global Marker
;;; Global Marker
;; Non-nil when global marker is active.
(defvar cua--global-mark-active nil)
@ -72,12 +72,12 @@
(move-marker cua--global-mark-marker (point))
(if (overlayp cua--global-mark-overlay)
(move-overlay cua--global-mark-overlay (point) (1+ (point)))
(setq cua--global-mark-overlay
(setq cua--global-mark-overlay
(make-overlay (point) (1+ (point))))
(overlay-put cua--global-mark-overlay 'face 'cua-global-mark-face))
(if (and cua-global-mark-blink-cursor-interval
(not cua--orig-blink-cursor-interval))
(setq cua--orig-blink-cursor-interval blink-cursor-interval
(setq cua--orig-blink-cursor-interval blink-cursor-interval
blink-cursor-interval cua-global-mark-blink-cursor-interval))
(setq cua--global-mark-active t)
(if msg
@ -325,7 +325,7 @@ With prefix argument, don't jump to global mark when cancelling it."
(move-to-column col)
(move-marker cua--global-mark-marker (point))
(move-overlay cua--global-mark-overlay (point) (1+ (point))))))))
(defun cua-cancel-global-mark ()
"Cancel the global mark."
@ -346,7 +346,7 @@ With prefix argument, don't jump to global mark when cancelling it."
(if (or (not (eq (current-buffer) (marker-buffer cua--global-mark-marker)))
(not (pos-visible-in-window-p (marker-position cua--global-mark-marker))))
(let ((w (selected-window)) (p (point)) h)
;; The following code is an attempt to keep the global mark visible in
;; The following code is an attempt to keep the global mark visible in
;; other window -- but it doesn't work.
(switch-to-buffer-other-window (marker-buffer cua--global-mark-marker) t)
(goto-char (marker-position cua--global-mark-marker))

34
lisp/emulation/cua-rect.el
View file

@ -88,7 +88,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
(let ((l cua--undo-list))
(while l
(if (eq (car (car l)) pending-undo-list)
(setq cua--restored-rectangle
(setq cua--restored-rectangle
(and (vectorp (cdr (car l))) (cdr (car l)))
l nil)
(setq l (cdr l)))))
@ -126,7 +126,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
(setcdr cul nil))
(setq cua--tidy-undo-counter (1+ cua--tidy-undo-counter))
(if cua--debug
(message "Clean undo list in %s (%d)"
(message "Clean undo list in %s (%d)"
(buffer-name) cc)))))))
(setq buffers (cdr buffers)))
(/= cnt cua--tidy-undo-counter)))
@ -176,7 +176,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
(let ((c (aref cua--rectangle 4)))
(if (not (integerp advance))
c
(aset cua--rectangle 4
(aset cua--rectangle 4
(if (= advance 0)
(- 3 c) ; opposite corner
(mod (+ c 4 advance) 4)))
@ -302,9 +302,9 @@ Knows about CUA rectangle highlighting in addition to standard undo."
(cua--rectangle-right (1+ (cua--rectangle-right)))
(move-to-column (cua--rectangle-right) pad))
((cua--rectangle-right-side)
(forward-char 1)
(forward-char 1)
(cua--rectangle-right (current-column)))
((or pad (eolp))
((or pad (eolp))
(cua--rectangle-left (1+ (cua--rectangle-left)))
(move-to-column (cua--rectangle-right) pad))
(t
@ -666,8 +666,8 @@ If command is repeated at same position, delete the rectangle."
;; Turn on rectangular marking mode by disabling transient mark mode
;; and manually handling highlighting from a post command hook.
;; Be careful if we are already marking a rectangle.
(setq cua--rectangle
(if (and cua--last-rectangle
(setq cua--rectangle
(if (and cua--last-rectangle
(eq (car cua--last-rectangle) (current-buffer))
(eq (car (cdr cua--last-rectangle)) (point)))
(cdr (cdr cua--last-rectangle))
@ -684,7 +684,7 @@ If command is repeated at same position, delete the rectangle."
(defun cua--deactivate-rectangle ()
;; This is used to clean up after `cua--activate-rectangle'.
(mapcar (function delete-overlay) cua--rectangle-overlays)
(setq cua--last-rectangle (cons (current-buffer)
(setq cua--last-rectangle (cons (current-buffer)
(cons (point) ;; cua-save-point
cua--rectangle))
cua--rectangle nil
@ -827,7 +827,7 @@ With prefix argument, the toggle restriction."
(cua--rectangle-restriction (car r) t (not (car (cdr (cdr r)))))
(cua--rectangle-restriction "" nil nil))
(cua--rectangle-restriction
(format "[%c]"
(format "[%c]"
(read-char "Restrictive rectangle (char): ")) t arg))))
(defun cua-move-rectangle-up ()
@ -1040,7 +1040,7 @@ The length of STRING need not be the same as the rectangle width."
(defun cua-sequence-rectangle (first incr fmt)
"Resequence each line of CUA rectangle starting from FIRST.
The numbers are formatted according to the FORMAT string."
(interactive
(interactive
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
(string-to-number
@ -1169,7 +1169,7 @@ With prefix arg, replace rectangle with output from command."
(interactive (list
current-prefix-arg
(read-from-minibuffer "Shell command on rectangle: "
nil nil nil
nil nil nil
'shell-command-history)))
(cua--rectangle-aux-replace -1 t t replace 1
'(lambda (s e)
@ -1185,7 +1185,7 @@ With prefix arg, replace rectangle with output from command."
"Remove the first line of the rectangle and scroll remaining lines up."
(interactive)
(cua--rectangle-aux-replace 0 t t t t
'(lambda (s e)
'(lambda (s e)
(if (= (forward-line 1) 0)
(delete-region s (point))))))
@ -1225,7 +1225,7 @@ With prefix arg, indent to that column."
indent)
(cua--rectangle-operation 'corners nil t pad
'(lambda (s e l r)
(move-to-column
(move-to-column
(if (cua--rectangle-right-side t)
(max (1+ r) col) l)
pad)
@ -1243,9 +1243,9 @@ With prefix arg, indent to that column."
(defun cua-help-for-rectangle (&optional help)
(interactive)
(let ((M (if cua-use-hyper-key " H-" " M-")))
(message
(message
(concat (if help "C-?:help" "")
M "p:pad" M "o:open" M "c:close" M "b:blank"
M "p:pad" M "o:open" M "c:close" M "b:blank"
M "s:string" M "f:fill" M "i:incr" M "n:seq"))))
@ -1273,7 +1273,7 @@ With prefix arg, indent to that column."
(cua--rectangle-bot t)
(cua--rectangle-top t))
(if (cua--rectangle-padding)
(setq unread-command-events
(setq unread-command-events
(cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))
(if cua--rectangle
(if (and mark-active
@ -1333,7 +1333,7 @@ With prefix arg, indent to that column."
(define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)
(define-key cua--rectangle-keymap [remap self-insert-command] 'cua-insert-char-rectangle)
(define-key cua--rectangle-keymap [remap self-insert-iso] 'cua-insert-char-rectangle)
;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--rectangle-keymap [t]
'(menu-item "sic" cua-insert-char-rectangle :filter cua--self-insert-char-p))

2
lisp/emulation/edt-lk201.el
View file

@ -43,7 +43,7 @@
;;; Code:
(defconst *EDT-keys*
'(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3])
'(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3])
("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7])
("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . [kp-separator])
("KP-" . [kp-subtract]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter])

2
lisp/emulation/edt-pc.el
View file

@ -72,7 +72,7 @@
;;; Code:
(defconst *EDT-keys*
'(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3])
'(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3])
("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7])
("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . "" )
("KP-" . [kp-add]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter])

96
lisp/emulation/edt.el
View file

@ -27,7 +27,7 @@
;;; Commentary:
;;
;;
;; This is Version 4.0 of the EDT Emulation for Emacs 19 and above.
;; It comes with special functions which replicate nearly all of EDT's
@ -41,10 +41,10 @@
;; Getting Started:
;; To start the EDT Emulation, first start Emacs and then enter
;; To start the EDT Emulation, first start Emacs and then enter
;;
;; M-x edt-emulation-on
;;
;;
;; to begin the emulation. After initialization is complete, the
;; following message will appear below the status line informing you
;; that the emulation has been enabled: "Default EDT keymap active".
@ -59,13 +59,13 @@
;; Emacs "etc" directory. It contains very helpful user information.
;; The EDT emulation consists of the following files:
;;
;;
;; edt-user.doc - User Instructions and Sample Customization File
;; edt.el - EDT Emulation Functions and Default Configuration
;; edt-lk201.el - Built-in support for DEC LK-201 Keyboards
;; edt-vt100.el - Built-in support for DEC VT-100 (and above) terminals
;; edt-pc.el - Built-in support for PC 101 Keyboards under MS-DOS
;; edt-mapper.el - Create an EDT LK-201 Map File for Keyboards Without
;; edt-mapper.el - Create an EDT LK-201 Map File for Keyboards Without
;; Built-in Support
;; Enhancements:
@ -81,7 +81,7 @@
;; following line
;;
;; (edt-set-scroll-margins "20%" "25%")
;;
;;
;; sets the top margin to 20% of the window and the bottom margin
;; to 25% of the window. To disable this feature, set each
;; margin to 0%. You can also invoke edt-set-scroll-margins
@ -91,13 +91,13 @@
;; NOTE: Another way to set the scroll margins is to use the
;; Emacs customization feature (not available in Emacs 19) to set
;; the following two variables directly:
;;
;;
;; edt-top-scroll-margin and edt-bottom-scroll-margin
;;
;; Enter the Emacs `customize' command. First select the Editing
;; group and then select the Emulations group. Finally, select
;; the Edt group and follow the directions.
;;
;;
;; 2. The SUBS command is now supported and bound to GOLD-Enter by
;; default. (This design was copied from tpu-edt.el.) Note, in
;; earlier versions of EDT Emulation, GOLD-Enter was assigned to
@ -149,9 +149,9 @@
;;; History:
;;
;;
;; Version 4.0 2000 Added New Features and Fixed a Few Bugs
;;
;;
;;; Code:
@ -198,7 +198,7 @@ setting replicates EDT's page delimiter behavior. The original value
is restored when edt-emulation-off is called."
:type 'boolean
:group 'edt)
(defcustom edt-use-EDT-control-key-bindings nil
"*Emacs MUST be restarted for a change in value to take effect!
Non-nil causes the control key bindings to be replaced with EDT
@ -209,7 +209,7 @@ use within the EDT emulation."
:group 'edt)
(defcustom edt-word-entities '(?\t)
"*Specifies the list of EDT word entity characters.
"*Specifies the list of EDT word entity characters.
The default list, (\?\\t), contains just the TAB character, which
emulates EDT. Characters are specified in the list using their
decimal ASCII values. A question mark, followed by the actual
@ -402,7 +402,7 @@ Argument NUM is the number of page delimiters to move."
;;; EDT defaults a section size to be 16 lines of its one and only
;;; 24-line window. That's two-thirds of the window at a time. The
;;; EDT SECT commands moves the cursor, not the window.
;;;
;;;
;;; This emulation of EDT's SECT moves the cursor approximately
;;; two-thirds of the current window at a time.
@ -491,7 +491,7 @@ Argument NUM is the number of EOL marks to move."
;;; This one is a tad messy. To emulate EDT's behavior everywhere in
;;; the file (beginning of file, end of file, beginning of line, end
;;; of line, etc.) it takes a bit of special handling.
;;;
;;;
;;; The variable edt-word-entities contains a list of characters which
;;; are to be viewed as distinct words where ever they appear in the
;;; buffer. This emulates the EDT line mode command SET ENTITY WORD.
@ -729,7 +729,7 @@ Optional argument FIND is t if this function is called from `edt-find'."
(if (equal edt-direction-string edt-forward-string)
(edt-find-forward t)
(edt-find-backward t)))
;;;
;;; FNDNXT
@ -798,7 +798,7 @@ Optional argument FIND is t if this function is called from `edt-find'."
(if (equal edt-direction-string edt-forward-string)
(edt-find-next-forward)
(edt-find-next-backward)))
;;;
;;; APPEND
;;;
@ -1008,7 +1008,7 @@ Argument NUM is the number of characters to delete."
(defun edt-substitute (num)
"Replace the selected region with the contents of the CUT buffer and.
Repeat the most recent FIND command. (The Emacs kill ring is used as
the CUT buffer.)
the CUT buffer.)
Argument NUM is the repeat count. A positive value indicates the of times
to repeat the substitution. A negative argument means replace all occurrences
of the search text."
@ -1087,7 +1087,7 @@ Also, execute command specified if in Minibuffer."
(exit-minibuffer))
(if edt-x-emacs19-p (setq zmacs-region-stays t)))
;;;
;;; BACKUP
;;;
@ -1205,7 +1205,7 @@ Argument NUM is the number of tabs to insert."
Argument NUM is the prefix value tested."
(if (<= num 0)
(error "Prefix must be positive")))
;;;
;;; Check Selection
;;;
@ -1277,7 +1277,7 @@ Argument BOTTOM is the bottom margin in number of lines or percent of window."
;;;; ENHANCEMENTS AND ADDITIONS FOR EDT KEYPAD MODE
;;;;
;;;
;;;
;;; Several enhancements and additions to EDT keypad mode commands are
;;; provided here. Some of these have been motivated by similar
;;; TPU/EVE and EVE-Plus commands. Others are new.
@ -1818,7 +1818,7 @@ Argument NUM is the number of times to duplicate the line."
(save-buffer)
(save-buffers-kill-emacs))
;;;
;;;
;;; QUIT
;;;
@ -1836,9 +1836,9 @@ Warn user that modifications will be lost."
(kill-emacs)
(setq working nil)))
(setq list (cdr list))))
(if working (kill-emacs))))
(if working (kill-emacs))))
;;;
;;;
;;; SPLIT WINDOW
;;;
@ -2024,7 +2024,7 @@ Optional argument NOT-YES changes the default to negative."
;;; Function used to load LK-201 key mapping file generated by edt-mapper.el.
;;;
(defun edt-load-keys (file)
"Load the LK-201 key mapping FILE generated by edt-mapper.el.
"Load the LK-201 key mapping FILE generated by edt-mapper.el.
If FILE is nil, which is the normal case, try to load a default file.
The default file names are based upon the window system, terminal
type, and version of Emacs in use: GNU Emacs or XEmacs (aka Lucid
@ -2042,7 +2042,7 @@ created."
"~/.edt-" edt-emacs-variant
(if edt-term (concat "-" edt-term))
(if edt-xserver (concat "-" edt-xserver))
(if edt-window-system
(if edt-window-system
(concat "-" (upcase (symbol-name edt-window-system))))
"-keys")))))
(cond ((file-readable-p file)
@ -2053,7 +2053,7 @@ created."
(insert "
Ack!! You're running the Enhanced EDT Emulation without loading an
EDT key mapping file. To create an EDT key mapping file, run the
EDT key mapping file. To create an EDT key mapping file, run the
edt-mapper.el program. It is safest to run it from an Emacs loaded
without any of your own customizations found in your .emacs file, etc.
The reason for this is that some user customizations confuse edt-mapper.
@ -2061,7 +2061,7 @@ created."
follows:
emacs -q -l edt-mapper.el
[NOTE: If you do nothing out of the ordinary in your .emacs file, and
the search for edt-mapper.el is successful, you can try running it now.]
@ -2412,7 +2412,7 @@ Argument GOLD-BINDING is the Emacs function to be bound to GOLD <KEY>."
'edt-key-not-assigned 'edt-key-not-assigned)
;; Control key bindings: Regular and GOLD
;;
;;
;; Standard EDT control key bindings conflict with standard Emacs
;; control key bindings. Normally, the standard Emacs control key
;; bindings are left unchanged in the default EDT mode. However, if
@ -2578,7 +2578,7 @@ Argument GOLD-BINDING is the Emacs function to be bound to GOLD <KEY>."
G-F9: Paste Rect Insert +----------+----------+----------+----------+
F10: Cut Rectangle
G-F10: Paste Rectangle
F11: ESC
F11: ESC
F12: Begining of Line +----------+----------+----------+----------+
G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L |
F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) |
@ -2600,7 +2600,7 @@ G-C-k: Restore Key | WORD | EOL | CHAR | Next |
C-t: Display the Time | (0) | (.) | SUBS |
C-u: Delete to Begin of Line | Open Line | RESET | |
C-v: Redraw Display +---------------------+----------+----------+
C-w: Set Screen Width 132
C-w: Set Screen Width 132
C-z: Suspend Emacs +----------+----------+----------+
G-C-\\: Split Window | FNDNXT | Yank | CUT |
| (FIND) | (INSERT) | (REMOVE) |
@ -2610,26 +2610,26 @@ G-C-\\: Split Window | FNDNXT | Yank | CUT |
G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) |
G-f: Find File | | | |
G-g: Find File Other Window +----------+----------+----------+
G-h: Keypad Help
G-i: Insert File
G-k: Toggle Capitalization Word
G-l: Downcase Region
G-m: Save Some Buffers
G-n: Next Error
G-h: Keypad Help
G-i: Insert File
G-k: Toggle Capitalization Word
G-l: Downcase Region
G-m: Save Some Buffers
G-n: Next Error
G-o: Switch to Next Window
G-q: Quit
G-r: Revert File
G-s: Save Buffer
G-u: Upcase Region
G-v: Find File Other Window
G-w: Write file
G-y: EDT Emulation OFF
G-q: Quit
G-r: Revert File
G-s: Save Buffer
G-u: Upcase Region
G-v: Find File Other Window
G-w: Write file
G-y: EDT Emulation OFF
G-z: Switch to User EDT Key Bindings
G-1: Delete Other Windows
G-2: Split Window
G-%: Go to Percentage
G- : Undo (GOLD Spacebar)
G-=: Go to Line
G-1: Delete Other Windows
G-2: Split Window
G-%: Go to Percentage
G- : Undo (GOLD Spacebar)
G-=: Go to Line
G-`: What line
G-/: Query-Replace"

12
lisp/emulation/keypad.el
View file

@ -113,7 +113,7 @@ decimal key must be specified."
(character :tag "Numeric Keypad with Decimal Key"
:match (lambda (widget value) (integerp value))
:value ?.)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Cursor keys" cursor)
(const :tag "Shifted cursor keys" S-cursor)
(const :tag "Unspecified/User-defined" none)
@ -136,7 +136,7 @@ decimal key must be specified."
(character :tag "Numeric Keypad with Decimal Key"
:match (lambda (widget value) (integerp value))
:value ?.)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Cursor keys" cursor)
(const :tag "Shifted cursor keys" S-cursor)
(const :tag "Unspecified/User-defined" none)
@ -159,7 +159,7 @@ decimal key must be specified."
(character :tag "Numeric Keypad with Decimal Key"
:match (lambda (widget value) (integerp value))
:value ?.)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Cursor keys" cursor)
(const :tag "Shifted cursor keys" S-cursor)
(const :tag "Unspecified/User-defined" none)
@ -182,7 +182,7 @@ decimal key must be specified."
(character :tag "Numeric Keypad with Decimal Key"
:match (lambda (widget value) (integerp value))
:value ?.)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Numeric prefix arguments" prefix)
(const :tag "Cursor keys" cursor)
(const :tag "Shifted cursor keys" S-cursor)
(const :tag "Unspecified/User-defined" none)
@ -244,7 +244,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.'"
[delete insert end down next left
space right home up prior])
((eq setup 'S-cursor)
[S-delete S-insert S-end S-down S-next S-left
[S-delete S-insert S-end S-down S-next S-left
S-space S-right S-home S-up S-prior])
((eq setup 'none)
nil)
@ -268,7 +268,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.'"
((eq (aref kp i) 'S-kp-space)
(define-key function-key-map [S-kp-begin]
(if bind (vector (aref bind i)))))))
(setq i (1+ i)))))
;;; keypad.el ends here

12
lisp/emulation/pc-select.el
View file

@ -185,7 +185,7 @@ restored to their original values when `pc-selection-mode' is toggled off.")
([C-up] . backward-paragraph-nomark) ; KPrevPara cUp
([S-C-down] . forward-paragraph-mark)
([S-C-up] . backward-paragraph-mark))))
(setq pc-select-default-key-bindings lst)))
(defvar pc-select-extra-key-bindings nil
@ -219,7 +219,7 @@ restored to their original values when `pc-selection-mode' is toggled off.")
([C-M-delete] . kill-sexp)
;; Next line proposed by Eli Barzilay
([C-escape] . electric-buffer-list))))
(setq pc-select-extra-key-bindings lst)))
(defvar pc-select-meta-moves-sexps-key-bindings
@ -773,7 +773,7 @@ restore the previous value of that key binding from SAVED-MAP."
(defmacro pc-select-add-to-alist (alist var val)
"Ensure that ALIST contains the cons cell (VAR . VAL).
If a cons cell whose car is VAR is already on the ALIST, update the
cdr of that cell with VAL. Otherwise, make a new cons cell
cdr of that cell with VAL. Otherwise, make a new cons cell
\(VAR . VAL), and prepend it onto ALIST."
(let ((elt (make-symbol "elt")))
`(let ((,elt (assq ',var ,alist)))
@ -803,7 +803,7 @@ variable MODE-VAR (instead of the value of the variable MODE) on
(,mode ,arg)))
(defmacro pc-select-restore-var (var)
"Restore the previous value of the variable VAR.
"Restore the previous value of the variable VAR.
Look up VAR's previous value in `pc-select-saved-settings-alist', and,
if the value is found, set VAR to that value."
(let ((elt (make-symbol "elt")))
@ -919,7 +919,7 @@ but before calling `pc-selection-mode'):
;; (setq-default normal-erase-is-backspace t)
;; However, the documentation for the variable says that
;; "setting it with setq has no effect", so I'm removing it.
(pc-select-save-and-set-var highlight-nonselected-windows nil)
(pc-select-save-and-set-var transient-mark-mode t)
(pc-select-save-and-set-var mark-even-if-inactive t)
@ -966,7 +966,7 @@ but before calling `pc-selection-mode'):
pc-select-old-M-delete-binding))
(setq pc-select-key-bindings-alist nil
pc-select-saved-settings-alist nil))))
;;;###autoload
(defcustom pc-selection-mode nil

40
lisp/emulation/vi.el
View file

@ -30,7 +30,7 @@
; (vi-mode))))))
; 3) In your .emacs file you can define the command "vi-mode" to be "autoload"
; or you can execute the "load" command to load "vi" directly.
; 4) Read the comments for command "vi-mode" before you start using it.
; 4) Read the comments for command "vi-mode" before you start using it.
;
; COULD DO
; 1). A general 'define-operator' function to replace current hack
@ -153,7 +153,7 @@ command extensions.")
(define-key vi-com-map "\C-\\" 'vi-unimplemented)
(define-key vi-com-map "\C-]" 'find-tag)
(define-key vi-com-map "\C-^" 'vi-locate-def) ; extension
(define-key vi-com-map "\C-_" 'vi-undefined)
(define-key vi-com-map "\C-_" 'vi-undefined)
(define-key vi-com-map " " 'forward-char)
(define-key vi-com-map "!" 'vi-operator)
@ -201,7 +201,7 @@ command extensions.")
(define-key vi-com-map "H" 'vi-home-window-line)
(define-key vi-com-map "I" 'vi-insert-before-first-nonwhite)
(define-key vi-com-map "J" 'vi-join-lines)
(define-key vi-com-map "K" 'vi-undefined)
(define-key vi-com-map "K" 'vi-undefined)
(define-key vi-com-map "L" 'vi-last-window-line)
(define-key vi-com-map "M" 'vi-middle-window-line)
(define-key vi-com-map "N" 'vi-reverse-last-search)
@ -212,7 +212,7 @@ command extensions.")
(define-key vi-com-map "S" 'vi-substitute-lines)
(define-key vi-com-map "T" 'vi-backward-upto-char)
(define-key vi-com-map "U" 'vi-unimplemented)
(define-key vi-com-map "V" 'vi-undefined)
(define-key vi-com-map "V" 'vi-undefined)
(define-key vi-com-map "W" 'vi-forward-blank-delimited-word)
(define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension
(define-key vi-com-map "Y" 'vi-yank-line)
@ -247,7 +247,7 @@ command extensions.")
(define-key vi-com-map "s" 'vi-substitute-chars)
(define-key vi-com-map "t" 'vi-forward-upto-char)
(define-key vi-com-map "u" 'undo)
(define-key vi-com-map "v" 'vi-verify-spelling)
(define-key vi-com-map "v" 'vi-verify-spelling)
(define-key vi-com-map "w" 'vi-forward-word)
(define-key vi-com-map "x" 'vi-kill-char)
(define-key vi-com-map "y" 'vi-operator)
@ -355,7 +355,7 @@ form that is ready to be `apply'ed.")
"Non-nil if it is in insert state.")
; in "loaddefs.el"
;(defvar search-last-string ""
;(defvar search-last-string ""
; "Last string search for by a search command.")
(defvar vi-search-last-command nil ; (re-)search-forward(backward)
@ -366,12 +366,12 @@ form that is ready to be `apply'ed.")
(defvar vi-mode-old-mode-name nil
"Save the mode-name before entering vi-mode.")
(defvar vi-mode-old-major-mode nil
"Save the major-mode before entering vi-mode.")
(defvar vi-mode-old-case-fold nil)
;(defconst vi-add-to-mode-line-1
; '(overwrite-mode nil " Insert"))
@ -404,7 +404,7 @@ form that is ready to be `apply'ed.")
(make-local-variable 'vi-mode-old-major-mode)
(make-local-variable 'vi-mode-old-case-fold)
(run-hooks 'vi-mode-hook))
;;;###autoload
(defun vi-mode ()
"Major mode that acts like the `vi' editor.
@ -448,7 +448,7 @@ Major differences between this mode and real vi :
`vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def',
`vi-mark-region', and 'vi-quote-words'. Some of them are quite handy.
- Use \\[vi-switch-mode] to switch among different modes quickly.
Syntax table and abbrevs while in vi mode remain as they were in Emacs."
(interactive)
(if (null vi-mode-old-major-mode) ; very first call for current buffer
@ -539,7 +539,7 @@ This function expects 'overwrite-mode' being set properly beforehand."
(<= vi-ins-repetition 0))
(vi-goto-command-state t)
(if (> vi-ins-repetition 1)
(progn
(progn
(let ((str (buffer-substring vi-ins-point (point))))
(while (> vi-ins-repetition 1)
(insert str)
@ -585,7 +585,7 @@ insert state."
(interactive "*r")
(kill-region start end)
(vi-set-last-change-command 'kill-region))
(defun vi-append-at-end-of-line (arg)
"go to end of line and then go into vi insert state."
(interactive "*p")
@ -651,7 +651,7 @@ insert state."
;;;;;
(defun vi-isearch-forward (arg)
"Incremental search forward. Use regexp version if ARG is non-nil."
"Incremental search forward. Use regexp version if ARG is non-nil."
(interactive "P")
(let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward))
(opoint (point)))
@ -724,7 +724,7 @@ If the optional search args are given, use those instead of the ones saved."
((eq search-command 'search-forward) 'search-backward)
((eq search-command 'search-backward) 'search-forward))
search-string nil nil arg)))
(defun vi-join-lines (arg)
"join ARG lines from current line (default 2), cleaning up white space."
(interactive "P")
@ -842,7 +842,7 @@ Goto mark '@' means jump into and pop the top mark on the mark ring."
(set-mark-command nil)
(goto-char mark)
(if line-flag (back-to-indentation)))))))
(defun vi-goto-line-mark (char)
"Go to the line (at first non-white) marked by next char."
(interactive "c")
@ -1062,7 +1062,7 @@ MOTION-COMMAND with ARG.
((eq moving-unit 'line)
(goto-char begin) (beginning-of-line) (setq begin (point))
(goto-char end) (next-line 1) (beginning-of-line) (setq end (point))))
(if (> end (point-max)) (setq end (point-max))) ; force in buffer region
(if (> end (point-max)) (setq end (point-max))) ; force in buffer region
(cons begin end)))))
(defun vi-delete-op (motion-command arg)
@ -1106,7 +1106,7 @@ Used in checking whether the yanked text should be put back as lines or not."
(= (aref string (1- (length string))) ?\n))
(defun vi-put-before (arg &optional after-p)
"Put yanked (in vi sense) text back before/above cursor.
"Put yanked (in vi sense) text back before/above cursor.
If a numeric prefix value (currently it should be >1) is given, put back
text as lines. If the optional after-p is given, put after/below the cursor."
(interactive "P")
@ -1302,7 +1302,7 @@ For the use of the prefix-arg, refer to individual functions called."
(interactive "*P")
(let ((rcmd (if arg 'replace-regexp 'replace-string)))
(call-interactively rcmd nil)))
(defun vi-adjust-window (arg position)
"Move current line to the top/center/bottom of the window."
(interactive "p\nc")
@ -1329,7 +1329,7 @@ For the use of the prefix-arg, refer to individual functions called."
(ding))))
(defun vi-name-last-change-or-macro (arg char)
"Give name to the last change command or just defined kbd macro.
"Give name to the last change command or just defined kbd macro.
If prefix ARG is given, name last macro, otherwise name last change command.
The following CHAR will be the name for the command or macro."
(interactive "P\nc")
@ -1343,7 +1343,7 @@ The following CHAR will be the name for the command or macro."
(vi-set-last-change-command 'vi-more-redo-insertion str
overwrite-p prefix-code)))
(fset (intern (char-to-string char)) vi-last-change-command)))
(defun vi-call-named-change-or-macro (count char)
"Execute COUNT times the keyboard macro definition named by the following CHAR."
(interactive "p\nc")

24
lisp/emulation/vip.el
View file

@ -49,7 +49,7 @@
(defvar vip-insert-local-map nil
"Local map used in insert command mode. (Buffer-specific.)")
(make-variable-buffer-local 'vip-emacs-local-map)
(make-variable-buffer-local 'vip-insert-local-map)
@ -113,7 +113,7 @@
(defvar vip-f-forward nil
"For use by \";\" command.")
(defvar vip-f-offset nil
"For use by \";\" command.")
@ -378,7 +378,7 @@ No message."
'delete-backward-char))
(define-key vip-insert-local-map "\C-w"
'vip-delete-backward-word))
((eq new-mode 'emacs-mode)
((eq new-mode 'emacs-mode)
(vip-change-mode-line "Emacs:")
(use-local-map vip-emacs-local-map)))
(setq vip-current-mode new-mode)
@ -508,7 +508,7 @@ EVENTS is a list of events, which become the beginning of the command."
"Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value
obtained so far, and COM is the command part obtained so far."
(while (and (>= char ?0) (<= char ?9))
(setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))
(setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))
(setq char (read-char)))
(setq prefix-arg value)
(if com (setq prefix-arg (cons prefix-arg com)))
@ -561,7 +561,7 @@ obtained so far, and COM is the command part obtained so far."
(setq com char)
(setq char (read-char)))))))
(if (atom com)
;; com is a single char, so we construct prefix-arg
;; com is a single char, so we construct prefix-arg
;; and if char is ?, describe prefix arg, otherwise exit by
;; pushing the char back
(progn
@ -615,7 +615,7 @@ obtained so far, and COM is the command part obtained so far."
(interactive "P")
(condition-case conditions
(vip-prefix-arg-com
last-command-char
last-command-char
(cond ((null arg) nil)
((consp arg) (car arg))
((numberp arg) arg)
@ -935,7 +935,7 @@ vi command mode. It will repeat the insertion command if original insertion
command was invoked with argument > 1."
(let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
(if (and val (> val 1)) ;; first check that val is non-nil
(progn
(progn
(setq vip-d-com (list i-com (1- val) ?r))
(vip-repeat nil)
(setq vip-d-com (list i-com val ?r))))))
@ -1037,7 +1037,7 @@ command was invoked with argument > 1."
(vip-change-subr (mark) (point))
(vip-change (mark) (point))))
(setq vip-d-com (list 'vip-substitute val ?r))))
(defun vip-substitute-line (arg)
"Substitute lines."
(interactive "p")
@ -1057,7 +1057,7 @@ command was invoked with argument > 1."
(interactive "P")
(let ((val (vip-p-val arg)))
(vip-line (cons val ?Y))))
;; region command
@ -1076,7 +1076,7 @@ command was invoked with argument > 1."
(move-marker vip-com-point (point))
(exchange-point-and-mark)
(vip-execute-com 'vip-Region val com)))
(defun vip-replace-char (arg)
"Replace the following ARG chars by the character read."
(interactive "P")
@ -1171,7 +1171,7 @@ beginning of buffer, stop and signal error."
(progn
(forward-char)
(vip-execute-com 'vip-end-of-word val com)))))
(defun vip-backward-word (arg)
"Backward word."
(interactive "P")
@ -2911,7 +2911,7 @@ a token has type \(command, address, end-mark\) and value."
(vip-change-mode-to-emacs)
(shell))
(defun ex-substitute (&optional repeat r-flag)
(defun ex-substitute (&optional repeat r-flag)
"ex substitute.
If REPEAT use previous reg-exp which is ex-reg-exp or
vip-s-string"

Some files were not shown because too many files have changed in this diff Show more