Mercurial > emacs

comparison lisp/subr.el @ 83310:e58cb448e07c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged from miles@gnu.org--gnu-2005 (patch 80-82, 350-422) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-350
author Karoly Lorentey <lorentey@elte.hu>
date Wed, 15 Jun 2005 12:57:51 +0000
parents 6aee1e9b0bd7 18169bc4f438
children c016d82bf02b
comparison
equal deleted inserted replaced
83309:6aee1e9b0bd7 83310:e58cb448e07c
954 (symbol-value list-var) 954 (symbol-value list-var)
955 (set list-var 955 (set list-var
956 (if append 956 (if append
957 (append (symbol-value list-var) (list element)) 957 (append (symbol-value list-var) (list element))
958 (cons element (symbol-value list-var)))))) 958 (cons element (symbol-value list-var))))))
959
960
961 (defun add-to-ordered-list (list-var element &optional order)
962 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
963 The test for presence of ELEMENT is done with `equal'.
964
965 The resulting list is reordered so that the elements are in the
966 order given by each element's numeric list order. Elements which
967 are not symbols, and symbol elements without a numeric list order
968 are placed at the end of the list.
969
970 If the third optional argument ORDER is non-nil and ELEMENT is
971 a symbol, set the symbol's list order to the given value.
972
973 The list order for each symbol is stored in LIST-VAR's
974 `list-order' property.
975
976 The return value is the new value of LIST-VAR."
977 (let* ((ordering (get list-var 'list-order))
978 (cur (and (symbolp element) (assq element ordering))))
979 (when order
980 (unless (symbolp element)
981 (error "cannot specify order for non-symbols"))
982 (if cur
983 (setcdr cur order)
984 (setq cur (cons element order))
985 (setq ordering (cons cur ordering))
986 (put list-var 'list-order ordering)))
987 (add-to-list list-var element)
988 (set list-var (sort (symbol-value list-var)
989 (lambda (a b)
990 (let ((oa (and (symbolp a) (assq a ordering)))
991 (ob (and (symbolp b) (assq b ordering))))
992 (cond
993 ((not oa) nil)
994 ((not ob) t)
995 (t (< (cdr oa) (cdr ob))))))))))
959 996
960 997
961 ;;; Load history 998 ;;; Load history
962 999
963 ;;; (defvar symbol-file-load-history-loaded nil 1000 ;;; (defvar symbol-file-load-history-loaded nil
1559 1596
1560 Strip text properties from the inserted text according to 1597 Strip text properties from the inserted text according to
1561 `yank-excluded-properties'. Otherwise just like (insert STRING). 1598 `yank-excluded-properties'. Otherwise just like (insert STRING).
1562 1599
1563 If STRING has a non-nil `yank-handler' property on the first character, 1600 If STRING has a non-nil `yank-handler' property on the first character,
1564 the normal insert behaviour is modified in various ways. The value of 1601 the normal insert behavior is modified in various ways. The value of
1565 the yank-handler property must be a list with one to five elements 1602 the yank-handler property must be a list with one to five elements
1566 with the following format: (FUNCTION PARAM NOEXCLUDE UNDO). 1603 with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
1567 When FUNCTION is present and non-nil, it is called instead of `insert' 1604 When FUNCTION is present and non-nil, it is called instead of `insert'
1568 to insert the string. FUNCTION takes one argument--the object to insert. 1605 to insert the string. FUNCTION takes one argument--the object to insert.
1569 If PARAM is present and non-nil, it replaces STRING as the object 1606 If PARAM is present and non-nil, it replaces STRING as the object
1933 entered. 1970 entered.
1934 1971
1935 The result of the `dynamic-completion-table' form is a function 1972 The result of the `dynamic-completion-table' form is a function
1936 that can be used as the ALIST argument to `try-completion' and 1973 that can be used as the ALIST argument to `try-completion' and
1937 `all-completion'. See Info node `(elisp)Programmed Completion'." 1974 `all-completion'. See Info node `(elisp)Programmed Completion'."
1975 (declare (debug (lambda-expr)))
1938 (let ((win (make-symbol "window")) 1976 (let ((win (make-symbol "window"))
1939 (string (make-symbol "string")) 1977 (string (make-symbol "string"))
1940 (predicate (make-symbol "predicate")) 1978 (predicate (make-symbol "predicate"))
1941 (mode (make-symbol "mode"))) 1979 (mode (make-symbol "mode")))
1942 `(lambda (,string ,predicate ,mode) 1980 `(lambda (,string ,predicate ,mode)
1954 as an argument to `try-completion'), the function FUN is called with arguments 1992 as an argument to `try-completion'), the function FUN is called with arguments
1955 ARGS. FUN must return the completion table that will be stored in VAR. 1993 ARGS. FUN must return the completion table that will be stored in VAR.
1956 If completion is requested in the minibuffer, FUN will be called in the buffer 1994 If completion is requested in the minibuffer, FUN will be called in the buffer
1957 from which the minibuffer was entered. The return value of 1995 from which the minibuffer was entered. The return value of
1958 `lazy-completion-table' must be used to initialize the value of VAR." 1996 `lazy-completion-table' must be used to initialize the value of VAR."
1997 (declare (debug (symbol lambda-expr def-body)))
1959 (let ((str (make-symbol "string"))) 1998 (let ((str (make-symbol "string")))
1960 `(dynamic-completion-table 1999 `(dynamic-completion-table
1961 (lambda (,str) 2000 (lambda (,str)
1962 (unless (listp ,var) 2001 (unless (listp ,var)
1963 (setq ,var (funcall ',fun ,@args))) 2002 (setq ,var (,fun ,@args)))
1964 ,var)))) 2003 ,var))))
2004
2005 (defmacro complete-in-turn (a b)
2006 "Create a completion table that first tries completion in A and then in B.
2007 A and B should not be costly (or side-effecting) expressions."
2008 (declare (debug (def-form def-form)))
2009 `(lambda (string predicate mode)
2010 (cond
2011 ((eq mode t)
2012 (or (all-completions string ,a predicate)
2013 (all-completions string ,b predicate)))
2014 ((eq mode nil)
2015 (or (try-completion string ,a predicate)
2016 (try-completion string ,b predicate)))
2017 (t
2018 (or (test-completion string ,a predicate)
2019 (test-completion string ,b predicate))))))
1965 2020
1966 ;;; Matching and substitution 2021 ;;; Matching and substitution
1967 2022
1968 (defvar save-match-data-internal) 2023 (defvar save-match-data-internal)
1969 2024
1980 (declare (indent 0) (debug t)) 2035 (declare (indent 0) (debug t))
1981 (list 'let 2036 (list 'let
1982 '((save-match-data-internal (match-data))) 2037 '((save-match-data-internal (match-data)))
1983 (list 'unwind-protect 2038 (list 'unwind-protect
1984 (cons 'progn body) 2039 (cons 'progn body)
1985 '(set-match-data save-match-data-internal)))) 2040 '(set-match-data save-match-data-internal 'evaporate))))
1986 2041
1987 (defun match-string (num &optional string) 2042 (defun match-string (num &optional string)
1988 "Return string of text matched by last search. 2043 "Return string of text matched by last search.
1989 NUM specifies which parenthesized expression in the last regexp. 2044 NUM specifies which parenthesized expression in the last regexp.
1990 Value is nil if NUMth pair didn't match, or there were less than NUM pairs. 2045 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.