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

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-71

Browse source 
Merge from emacs--cvs-trunk--0

Patches applied:

 * emacs--cvs-trunk--0  (patch 485-492)

   - Update from CVS
   - Merge from gnus--rel--5.10

 * gnus--rel--5.10  (patch 92-94)

   - Merge from emacs--cvs-trunk--0
   - Update from CVS
This commit is contained in:
Miles Bader 2005-07-22 08:27:27 +00:00
commit 3674ae2f87
204 changed files with 4074 additions and 2530 deletions
Download patch file Download diff file Expand all files Collapse all files

51
lisp/emacs-lisp/bytecomp.el
View file

@ -358,7 +358,7 @@ Elements of the list may be be:
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file)
insert-file insert-buffer insert-file-literally)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-var nil
@ -3355,12 +3355,12 @@ That command is designed for interactive use only" fn))
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
BODY is the code to compile first arm of the if or the body of the
cond clause. If CONDITION's value is of the form `(foundp 'foo)'
or `(boundp 'foo)', the relevant warnings from BODY about foo
cond clause. If CONDITION's value is of the form (fboundp 'foo)
or (boundp 'foo), the relevant warnings from BODY about foo's
being undefined will be suppressed.
If CONDITION's value is `(featurep 'xemacs)', that suppresses all
warnings during execution of BODY."
If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
`(let* ((fbound
(if (eq 'fboundp (car-safe ,condition))
@ -3379,8 +3379,10 @@ warnings during execution of BODY."
(if bound
(cons bound byte-compile-bound-variables)
byte-compile-bound-variables))
;; Suppress all warnings, for code not used in Emacs.
(byte-compile-warnings
(if (equal ,condition '(featurep 'xemacs))
(if (member ,condition '((featurep 'xemacs)
(not (featurep 'emacs))))
nil byte-compile-warnings)))
(unwind-protect
(progn ,@body)
@ -3409,7 +3411,8 @@ warnings during execution of BODY."
(byte-compile-form (nth 2 form) for-effect))
(byte-compile-goto 'byte-goto donetag)
(byte-compile-out-tag elsetag)
(byte-compile-body (cdr (cdr (cdr form))) for-effect)
(byte-compile-maybe-guarded (list 'not clause)
(byte-compile-body (cdr (cdr (cdr form))) for-effect))
(byte-compile-out-tag donetag))))
(setq for-effect nil))
@ -3450,24 +3453,38 @@ warnings during execution of BODY."
(args (cdr form)))
(if (null args)
(byte-compile-form-do-effect t)
(while (cdr args)
(byte-compile-form (car args))
(byte-compile-and-recursion args failtag))))
;; Handle compilation of a nontrivial `and' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-and-recursion (rest failtag)
(if (cdr rest)
(progn
(byte-compile-form (car rest))
(byte-compile-goto-if nil for-effect failtag)
(setq args (cdr args)))
(byte-compile-form-do-effect (car args))
(byte-compile-out-tag failtag))))
(byte-compile-maybe-guarded (car rest)
(byte-compile-and-recursion (cdr rest) failtag)))
(byte-compile-form-do-effect (car rest))
(byte-compile-out-tag failtag)))
(defun byte-compile-or (form)
(let ((wintag (byte-compile-make-tag))
(args (cdr form)))
(if (null args)
(byte-compile-form-do-effect nil)
(while (cdr args)
(byte-compile-form (car args))
(byte-compile-or-recursion args wintag))))
;; Handle compilation of a nontrivial `or' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-or-recursion (rest wintag)
(if (cdr rest)
(progn
(byte-compile-form (car rest))
(byte-compile-goto-if t for-effect wintag)
(setq args (cdr args)))
(byte-compile-form-do-effect (car args))
(byte-compile-out-tag wintag))))
(byte-compile-maybe-guarded (list 'not (car rest))
(byte-compile-or-recursion (cdr rest) wintag)))
(byte-compile-form-do-effect (car rest))
(byte-compile-out-tag wintag)))
(defun byte-compile-while (form)
(let ((endtag (byte-compile-make-tag))

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

@ -430,32 +430,20 @@ be re-created.")
;;; Compatibility
;;
(if (string-match "X[Ee]macs" emacs-version)
(progn
(defalias 'checkdoc-make-overlay 'make-extent)
(defalias 'checkdoc-overlay-put 'set-extent-property)
(defalias 'checkdoc-delete-overlay 'delete-extent)
(defalias 'checkdoc-overlay-start 'extent-start)
(defalias 'checkdoc-overlay-end 'extent-end)
(defalias 'checkdoc-mode-line-update 'redraw-modeline)
(defalias 'checkdoc-call-eval-buffer 'eval-buffer)
)
(defalias 'checkdoc-make-overlay 'make-overlay)
(defalias 'checkdoc-overlay-put 'overlay-put)
(defalias 'checkdoc-delete-overlay 'delete-overlay)
(defalias 'checkdoc-overlay-start 'overlay-start)
(defalias 'checkdoc-overlay-end 'overlay-end)
(defalias 'checkdoc-mode-line-update 'force-mode-line-update)
(defalias 'checkdoc-call-eval-buffer 'eval-current-buffer)
)
;; Emacs 20s have MULE characters which don't equate to numbers.
(if (fboundp 'char=)
(defalias 'checkdoc-char= 'char=)
(defalias 'checkdoc-char= '=))
;; Read events, not characters
(defalias 'checkdoc-read-event 'read-event)
(defalias 'checkdoc-make-overlay
(if (featurep 'xemacs) 'make-extent 'make-overlay))
(defalias 'checkdoc-overlay-put
(if (featurep 'xemacs) 'set-extent-property 'overlay-put))
(defalias 'checkdoc-delete-overlay
(if (featurep 'xemacs) 'delete-extent 'delete-overlay))
(defalias 'checkdoc-overlay-start
(if (featurep 'xemacs) 'extent-start 'overlay-start))
(defalias 'checkdoc-overlay-end
(if (featurep 'xemacs) 'extent-end 'overlay-end))
(defalias 'checkdoc-mode-line-update
(if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
(defalias 'checkdoc-char=
(if (featurep 'xemacs) 'char= '=))
;;; User level commands
;;
@ -628,7 +616,7 @@ style."
(goto-char (checkdoc-error-start (car (car err-list))))
(if (not (pos-visible-in-window-p))
(recenter (- (window-height) 2)))
(setq c (checkdoc-read-event)))
(setq c (read-event)))
(if (not (integerp c)) (setq c ??))
(cond
;; Exit condition
@ -844,7 +832,7 @@ Evaluation is done first because good documentation for something that
doesn't work is just not useful. Comments, doc strings, and rogue
spacing are all verified."
(interactive)
(checkdoc-call-eval-buffer nil)
(eval-buffer nil)
(checkdoc-current-buffer t))
;;;###autoload

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

@ -2384,6 +2384,7 @@ The type name can then be used in `typecase', `check-type', etc."
(cl-make-type-test val (funcall (get type 'cl-deftype-handler))))
((memq type '(nil t)) type)
((eq type 'null) `(null ,val))
((eq type 'atom) `(atom ,val))
((eq type 'float) `(floatp-safe ,val))
((eq type 'real) `(numberp ,val))
((eq type 'fixnum) `(integerp ,val))
@ -2398,7 +2399,7 @@ The type name can then be used in `typecase', `check-type', etc."
(cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
(cdr type))))
((memq (car type) '(integer float real number))
(delq t (and (cl-make-type-test val (car type))
(delq t (list 'and (cl-make-type-test val (car type))
(if (memq (cadr type) '(* nil)) t
(if (consp (cadr type)) (list '> val (caadr type))
(list '>= val (cadr type))))

17
lisp/emacs-lisp/derived.el
View file

@ -96,7 +96,7 @@
;;; PRIVATE: defsubst must be defined before they are first used
(defsubst derived-mode-hook-name (mode)
"Construct the mode hook name based on mode name MODE."
"Construct a mode-hook name based on a MODE name."
(intern (concat (symbol-name mode) "-hook")))
(defsubst derived-mode-map-name (mode)
@ -382,18 +382,11 @@ Always merge its parent into it, since the merge is non-destructive."
(derived-mode-merge-abbrev-tables old-table new-table)
(setq local-abbrev-table new-table)))
;;;(defun derived-mode-run-setup-function (mode)
;;; "Run the setup function if it exists."
;;; (let ((fname (derived-mode-setup-function-name mode)))
;;; (if (fboundp fname)
;;; (funcall fname))))
(defun derived-mode-run-hooks (mode)
"Run the mode hook for MODE."
(let ((hooks-name (derived-mode-hook-name mode)))
(if (boundp hooks-name)
(run-hooks hooks-name))))
"Run the mode hook for MODE."
(let ((hooks-name (derived-mode-hook-name mode)))
(if (boundp hooks-name)
(run-hooks hooks-name))))
;; Functions to merge maps and tables.

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

@ -142,8 +142,10 @@ For example, you could write
(let* ((mode-name (symbol-name mode))
(pretty-name (easy-mmode-pretty-mode-name mode lighter))
(globalp nil)
(set nil)
(initialize nil)
(group nil)
(type nil)
(extra-args nil)
(extra-keywords nil)
(require t)
@ -160,8 +162,10 @@ For example, you could write
(:lighter (setq lighter (pop body)))
(:global (setq globalp (pop body)))
(:extra-args (setq extra-args (pop body)))
(:set (setq set (list :set (pop body))))
(:initialize (setq initialize (list :initialize (pop body))))
(:group (setq group (nconc group (list :group (pop body)))))
(:type (setq type (list :type (pop body))))
(:require (setq require (pop body)))
(:keymap (setq keymap (pop body)))
(t (push keyw extra-keywords) (push (pop body) extra-keywords))))
@ -169,9 +173,10 @@ For example, you could write
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
(unless set (setq set '(:set 'custom-set-minor-mode)))
(unless initialize
(setq initialize
'(:initialize 'custom-initialize-default)))
(setq initialize '(:initialize 'custom-initialize-default)))
(unless group
;; We might as well provide a best-guess default group.
@ -179,6 +184,8 @@ For example, you could write
`(:group ',(intern (replace-regexp-in-string
"-mode\\'" "" mode-name)))))
(unless type (setq type '(:type 'boolean)))
`(progn
;; Define the variable to enable or disable the mode.
,(if (not globalp)
@ -201,10 +208,10 @@ See the command `%s' for a description of this minor-mode."))
`(defcustom ,mode ,init-value
,(format base-doc-string pretty-name mode mode)
:set 'custom-set-minor-mode
,@set
,@initialize
,@group
:type 'boolean
,@type
,@(cond
((not (and curfile require)) nil)
((not (eq require t)) `(:require ,require)))
@ -260,12 +267,7 @@ With zero or negative ARG turn mode off.
(add-minor-mode ',mode ',lighter
,(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)))
(eval-after-load load-file-name '(,mode (if ,mode 1 -1))))))))
(symbol-value ',keymap-sym)))))))
;;;
;;; make global minor mode

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

@ -243,9 +243,9 @@ Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
`(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
(defmacro def-edebug-form-spec (symbol spec-form)
"For compatibility with old version. Use `def-edebug-spec' instead."
(message "Obsolete: use def-edebug-spec instead.")
"For compatibility with old version."
(def-edebug-spec symbol (eval spec-form)))
(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")
(defun get-edebug-spec (symbol)
;; Get the spec of symbol resolving all indirection.
@ -3651,9 +3651,12 @@ Return the result of the last expression."
;; Replace printing functions.
;; obsolete names
(defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
(defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
(defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
(define-obsolete-function-alias 'edebug-install-custom-print-funcs
'edebug-install-custom-print "22.1")
(define-obsolete-function-alias 'edebug-reset-print-funcs
'edebug-uninstall-custom-print "22.1")
(define-obsolete-function-alias 'edebug-uninstall-custom-print-funcs
'edebug-uninstall-custom-print "22.1")
(defun edebug-install-custom-print ()
"Replace print functions used by Edebug with custom versions."

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

@ -62,7 +62,7 @@
;; (define-derived-mode foo ...), (define-minor-mode foo)
(concat
"^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
ine-minor-mode\\|un-cvs-mode\\|foo\\|[^cfgv]\\w+\\*?\\)\
ine-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|foo\\|[^cfgv]\\w+\\*?\\)\
\\|easy-mmode-define-global-mode\\|menu-bar-make-toggle\\)"
find-function-space-re
"\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)")

136
lisp/emacs-lisp/find-gc.el
View file

@ -23,56 +23,86 @@
;;; Commentary:
;; Produce in unsafe-list the set of all functions that may invoke GC.
;; This expects the Emacs sources to live in emacs-source-directory.
;; Produce in find-gc-unsafe-list the set of all functions that may invoke GC.
;; This expects the Emacs sources to live in find-gc-source-directory.
;; It creates a temporary working directory /tmp/esrc.
;;; Code:
(defun find-gc-unsafe ()
(trace-call-tree nil)
(trace-use-tree)
(find-unsafe-funcs 'Fgarbage_collect)
(setq unsafe-list (sort unsafe-list
(function (lambda (x y)
(string-lessp (car x) (car y))))))
)
(defvar find-gc-unsafe-list nil
"The list of unsafe functions is placed here by `find-gc-unsafe'.")
(setq emacs-source-directory "/usr/gnu/src/dist/src")
(defvar find-gc-source-directory)
(defvar find-gc-subrs-callers nil
"Alist of users of subrs, from GC testing.
Each entry has the form (FUNCTION . FUNCTIONS-THAT-CALL-IT).")
;;; This does a depth-first search to find all functions that can
;;; ultimately call the function "target". The result is an a-list
;;; in unsafe-list; the cars are the unsafe functions, and the cdrs
;;; are (one of) the unsafe functions that these functions directly
;;; call.
(defun find-unsafe-funcs (target)
(setq unsafe-list (list (list target)))
(trace-unsafe target)
)
(defun trace-unsafe (func)
(let ((used (assq func subrs-used)))
(or used
(error "No subrs-used for %s" (car unsafe-list)))
(while (setq used (cdr used))
(or (assq (car used) unsafe-list)
(memq (car used) noreturn-list)
(progn
(setq unsafe-list (cons (cons (car used) func) unsafe-list))
(trace-unsafe (car used))))))
)
(defvar find-gc-subrs-called nil
"Alist of subrs called, in GC testing.
Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).")
;;; Functions on this list are safe, even if they appear to be able
;;; to call the target.
(setq noreturn-list '( Fsignal Fthrow wrong_type_argument ))
(defvar find-gc-noreturn-list '(Fsignal Fthrow wrong_type_argument))
;;; This was originally generated directory-files, but there were
;;; too many files there that were not actually compiled. The
;;; list below was created for a HP-UX 7.0 system.
(defvar find-gc-source-files
'("dispnew.c" "scroll.c" "xdisp.c" "window.c"
"term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c"
"keymap.c" "sysdep.c" "buffer.c" "filelock.c"
"insdel.c" "marker.c" "minibuf.c" "fileio.c"
"dired.c" "filemode.c" "cmds.c" "casefiddle.c"
"indent.c" "search.c" "regex.c" "undo.c"
"alloc.c" "data.c" "doc.c" "editfns.c"
"callint.c" "eval.c" "fns.c" "print.c" "lread.c"
"abbrev.c" "syntax.c" "unexec.c"
"bytecode.c" "process.c" "callproc.c" "doprnt.c"
"x11term.c" "x11fns.c"))
(defun find-gc-unsafe ()
"Return a list of unsafe functions--that is, which can call GC.
Also store it in `find-gc-unsafe'."
(trace-call-tree nil)
(trace-use-tree)
(find-unsafe-funcs 'Fgarbage_collect)
(setq find-gc-unsafe-list
(sort find-gc-unsafe-list
(function (lambda (x y)
(string-lessp (car x) (car y))))))
)
;;; This does a depth-first search to find all functions that can
;;; ultimately call the function "target". The result is an a-list
;;; in find-gc-unsafe-list; the cars are the unsafe functions, and the cdrs
;;; are (one of) the unsafe functions that these functions directly
;;; call.
(defun find-unsafe-funcs (target)
(setq find-gc-unsafe-list (list (list target)))
(trace-unsafe target)
)
(defun trace-unsafe (func)
(let ((used (assq func find-gc-subrs-callers)))
(or used
(error "No find-gc-subrs-callers for %s" (car find-gc-unsafe-list)))
(while (setq used (cdr used))
(or (assq (car used) find-gc-unsafe-list)
(memq (car used) find-gc-noreturn-list)
(progn
(push (cons (car used) func) find-gc-unsafe-list)
(trace-unsafe (car used))))))
)
;;; This produces an a-list of functions in subrs-called. The cdr of
;;; each entry is a list of functions which the function in car calls.
(defun trace-call-tree (&optional already-setup)
(message "Setting up directories...")
@ -83,12 +113,12 @@
(call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc")
(call-process "csh" nil nil nil "-c"
(format "ln -s %s/*.[ch] /tmp/esrc"
emacs-source-directory))))
find-gc-source-directory))))
(save-excursion
(set-buffer (get-buffer-create "*Trace Call Tree*"))
(setq subrs-called nil)
(setq find-gc-subrs-called nil)
(let ((case-fold-search nil)
(files source-files)
(files find-gc-source-files)
name entry)
(while files
(message "Compiling %s..." (car files))
@ -105,7 +135,7 @@
(match-end 0))))
(message "%s : %s" (car files) name)
(setq entry (list name)
subrs-called (cons entry subrs-called)))
find-gc-subrs-called (cons entry find-gc-subrs-called)))
(if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
(progn
(setq name (intern (buffer-substring (match-beginning 1)
@ -117,34 +147,14 @@
)
;;; This was originally generated directory-files, but there were
;;; too many files there that were not actually compiled. The
;;; list below was created for a HP-UX 7.0 system.
(setq source-files '("dispnew.c" "scroll.c" "xdisp.c" "window.c"
"term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c"
"keymap.c" "sysdep.c" "buffer.c" "filelock.c"
"insdel.c" "marker.c" "minibuf.c" "fileio.c"
"dired.c" "filemode.c" "cmds.c" "casefiddle.c"
"indent.c" "search.c" "regex.c" "undo.c"
"alloc.c" "data.c" "doc.c" "editfns.c"
"callint.c" "eval.c" "fns.c" "print.c" "lread.c"
"abbrev.c" "syntax.c" "unexec.c"
"bytecode.c" "process.c" "callproc.c" "doprnt.c"
"x11term.c" "x11fns.c"))
;;; This produces an inverted a-list in subrs-used. The cdr of each
;;; entry is a list of functions that call the function in car.
(defun trace-use-tree ()
(setq subrs-used (mapcar 'list (mapcar 'car subrs-called)))
(let ((ptr subrs-called)
(setq find-gc-subrs-callers (mapcar 'list (mapcar 'car find-gc-subrs-called)))
(let ((ptr find-gc-subrs-called)
p2 found)
(while ptr
(setq p2 (car ptr))
(while (setq p2 (cdr p2))
(if (setq found (assq (car p2) subrs-used))
(if (setq found (assq (car p2) find-gc-subrs-callers))
(setcdr found (cons (car (car ptr)) (cdr found)))))
(setq ptr (cdr ptr))))
)

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

@ -54,8 +54,9 @@
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\n "> " table)
;; Give CR the same syntax as newline, for selective-display.
(modify-syntax-entry ?\^m "> " table)
;;; This is probably obsolete since nowadays such features use overlays.
;;; ;; Give CR the same syntax as newline, for selective-display.
;;; (modify-syntax-entry ?\^m "> " table)
(modify-syntax-entry ?\; "< " table)
(modify-syntax-entry ?` "' " table)
(modify-syntax-entry ?' "' " table)

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

@ -319,7 +319,8 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
;; emacs/xemacs compatibility
(if (fboundp 'frame-parameter)
(frame-parameter (selected-frame) 'display-type)
(frame-property (selected-frame) 'display-type))))
(if (fboundp 'frame-property)
(frame-property (selected-frame) 'display-type)))))
(defsubst reb-lisp-syntax-p ()
"Return non-nil if RE Builder uses a Lisp syntax."
@ -331,10 +332,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
;;; This is to help people find this in Apropos.
;;;###autoload
(defun regexp-builder ()
"Alias for `re-builder': Construct a regexp interactively."
(interactive)
(re-builder))
(defalias 'regexp-builder 're-builder)
;;;###autoload
(defun re-builder ()
@ -610,7 +608,8 @@ optional fourth argument FORCE is non-nil."
(defun reb-cook-regexp (re)
"Return RE after processing it according to `reb-re-syntax'."
(cond ((eq reb-re-syntax 'lisp-re)
(lre-compile-string (eval (car (read-from-string re)))))
(if (fboundp 'lre-compile-string)
(lre-compile-string (eval (car (read-from-string re))))))
((eq reb-re-syntax 'sregex)
(apply 'sregex (eval (car (read-from-string re)))))
((eq reb-re-syntax 'rx)