annotate lisp/emacs-lisp/cl-compat.el @ 10219:d97313bb6f39

(bibtex-string, bibtex-preamble): Use forward-line. (sort-subr): Don't call autload for this--that's done in loaddefs.el. (bibtex-mode): Add autoload cookie. Changed keybinding for bibtex-print-help-message (from \C-ch to \C-c?). Therefore, describe-mode is not longer on \C-c?. Also, changed prefix \C-cn for bibtex-narrow functions to \C-c\C-r. (bibtex-string-files): Changed documentation. (bibtex-mode-map): Inscriptions of menu bar changed from "Entry Types" to "Entry-Types" and "Bibtex Edit" to "BibTeX-Edit". (bibtex-string-files): Changed documentation. (bibtex-mode): If environment variable BIBINPUTS isn't defined, string files are searched in the current directory. (bibtex-completion-candidates): Now buffer-local to allow evaluation of different bibtex-string-files in different buffers. (bibtex-autokey-edit-before-use, bibtex-clean-entry): New variable that determines, if the user is allowed to edit auto-generated reference keys before they are used. (bibtex-generate-autokey, bibtex-clean-entry): New function to generate an autokey if necessary. (bibtex-autokey-names, bibtex-autokey-name-change-strings, bibtex-autokey-name-length, bibtex-autokey-name-separator, bibtex-autokey-year-length, bibtex-autokey-titlewords, bibtex-autokey-title-terminators, bibtex-autokey-titlewords-stretch, bibtex-autokey-titleword-first-ignore, bibtex-autokey-titleword-abbrevs, bibtex-autokey-titleword-change-strings, bibtex-autokey-titleword-length, bibtex-autokey-titleword-separator, bibtex-autokey-name-year-separator, bibtex-autokey-year-title-separator): New variables related to bibtex-generate-autokey. (bibtex-find-entry-location): Optional second parameter maybedup to tell it that entering a duplicate entry isn't to report by an error but by the return value of the function (necessary for bibtex-clean-entry to find the correct position of an entry with an autogenerated key without disturbing the user with unwanted messages). (bibtex-help-message): New variable to avoid printing of help messages in the echo area. (assoc-of-regexp): New function to match an alist of regexps. (bibtex-string-files, bibtex-completion-candidates, bibtex-mode): New variables to allow bibtex-complete-string to work on strings initialized from a variable and from @String definitions in a list of files, too. (bibtex-predefined-strings, bibtex-entry-field-alist): Changed to user options. (bibtex-mode): Changed doc string. (many functions and variables): Changed documentation strings of variables and functions to hold a complete sentence in the first line. (bibtex-print-help-message): Now line dependent and reports if it is called outside a BibTeX field. (validate-bibtex-buffer): Completely rewritten to validate, if buffer is syntactically correct. (find-bibtex-duplicates): Moved into validate-bibtex-buffer. (ispell-abstract, bibtex-ispell-abstract, ispell-bibtex-entry, bibtex-ispell-entry, beginning-of-bibtex-entry, bibtex-beginning-of-entry, end-of-bibtex-entry, bibtex-end-of-entry, hide-bibtex-entry-bodies, bibtex-hide-entry-bodies, narrow-to-bibtex-entry, bibtex-narrow-to-entry, sort-bibtex-entries, bibtex-sort-entries, validate-bibtex-buffer, bibtex-validate-buffer, find-bibtex-entry-location, bibtex-find-entry-location): All interactive functions are renamed, so that any interface function begins with "bibtex-". Mapping: ispell-abstract --> bibtex-ispell-abstract ispell-bibtex-entry --> bibtex-ispell-entry beginning-of-bibtex-entry --> bibtex-beginning-of-entry end-of-bibtex-entry --> bibtex-end-of-entry hide-bibtex-entry-bodies --> bibtex-hide-entry-bodies narrow-to-bibtex-entry --> bibtex-narrow-to-entry sort-bibtex-entries --> bibtex-sort-entries validate-bibtex-buffer --> bibtex-validate-buffer find-bibtex-entry-location --> bibtex-find-entry-location (bibtex-maintain-sorted-entries, bibtex-sort-ignore-string-entries): Default is now t. (bibtex-complete-string): String list is built from additional string list bibtex-predefined-string and current strings in file. (string-equalp): Deleted and substituted by string-equal. (assoc-string-equalp): Renamed to assoc-ignore-case. (bibtex-entry): Reference key can be entered with completion. All reference keys that are defined in buffer and all labels that appear in crossreference entries are object to completion. (Entry types): Changed order of entries in menu "entry types". (bibtex-entry-field-alist): Changed order of entries slightly to be more conform with standard BibTeX style layouts. (bibtex-mode-map): Uniform keybindings for \C-c\C-e prefix (often used types on control keys, sometimes used types on normal keys, rarely used types on shift keys, almost never used types on meta keys). (bibtex-mode-map): Function narrow-to-bibtex-entry and counterpart widen and function hide-bibtex-entry-bodies and counterpart show-all bounded to appropriate local keys. (bibtex-abbrev-table): Deleted (bibtex-current-entry-label, put-string-on-kill-ring): Deleted (AUCTeX provides all the functionality needed for citation completion). (bibtex-enclosing-reference, bibtex-pop-previous, bibtex-pop-next, bibtex-clean-entry): Hacked for speed (bibtex-pop-previous and bibtex-pop-next were to slow for larger BibTeX files). (bibtex-pop-previous, bibtex-pop-next): Delimiters from previous or next entry are changed to actual delimters if necessary. (bibtex-entry): Fixed bug (False entry wasn't reported in error message if bibtex-entry was called with undefined reference name). (bibtex-entry-field-alist, bibtex-entry, bibtex-make-field, bibtex-next-field, bibtex-clean-entry): Every reference entry now contains a comment in addition to the name of the reference. This comment appears in the echo area if you start editing that field (after calling bibtex-next-field). (bibtex-include-OPTcrossref, bibtex-entry): Changed bibtex-include-OPTcrossref from single boolean variable to hold a list of reference names which should have a crossref field. (bibtex-complete-word): New function, which completes word fragment before point to the longest prefix of predefined strings in the buffer in the same way that ispell-complete-word operates for words found in the dictionary. (bibtex-reference-head): Start of bibtex-reference-head changed from "^[ \t]*\\(" to "^\\( \\|\t\\)*\\(" (bibtex-pop-previous and bibtex-pop-next didn't work, probably due to a bug in re-search-forward). (several functions): Added support for {} as field delimiters (better than '"' for accented characters. (bibtex-clean-entry): If optional field crossref is empty or missing, former optional fields (if bibtex-include-OPTcrossref was t) are necessary again. bibtex-clean-entry complains if they are empty but not if they are missing, so you can intenionally omit them, e. g. for a pseudo @Journal entry (needed for crossreferences) made out of an @article with missing non-optional fields. Menu bar entries aren't centered anymore.
author Richard M. Stallman <rms@gnu.org>
date Fri, 23 Dec 1994 04:18:29 +0000
parents bc5dccc5375f
children ac7375e60931
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Version: 2.02
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Keywords: extensions
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 1, or (at your option)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; any later version.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
7942
bc5dccc5375f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 4355
diff changeset
25 ;;; Commentary:
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;; These are extensions to Emacs Lisp that provide a degree of
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; Common Lisp compatibility, beyond what is already built-in
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; in Emacs Lisp.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;;
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; This package was written by Dave Gillespie; it is a complete
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;;
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;;
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 ;; Bug reports, comments, and suggestions are welcome!
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 ;; This file contains emulations of internal routines of the older
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;; CL package which users may have called directly from their code.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;; Use (require 'cl-compat) to get these routines.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;; See cl.el for Change Log.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
7942
bc5dccc5375f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 4355
diff changeset
45 ;;; Code:
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 ;; Require at load-time, but not when compiling cl-compat.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (or (featurep 'cl) (require 'cl))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;;; Keyword routines not supported by new package.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (defmacro defkeyword (x &optional doc)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (list* 'defconst x (list 'quote x) (and doc (list doc))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (defun keywordp (sym)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (defun keyword-of (sym)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (or (keywordp sym) (keywordp (intern (format ":%s" sym)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 ;;; Multiple values. Note that the new package uses a different
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;;; convention for multiple values. The following definitions
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 ;;; emulate the old convention; all function names have been changed
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 ;;; by capitalizing the first letter: Values, Multiple-value-*,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ;;; to avoid conflict with the new-style definitions in cl-macs.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (put 'Multiple-value-bind 'lisp-indent-function 2)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (put 'Multiple-value-setq 'lisp-indent-function 2)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (put 'Multiple-value-call 'lisp-indent-function 1)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (put 'Multiple-value-prog1 'lisp-indent-function 1)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (defvar *mvalues-values* nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (defun Values (&rest val-forms)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (setq *mvalues-values* val-forms)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 (car val-forms))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (defun Values-list (val-forms)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (apply 'values val-forms))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (defmacro Multiple-value-list (form)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (list *mvalues-temp*))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (defmacro Multiple-value-call (function &rest args)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 (list 'apply function
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 (cons 'append
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 (mapcar (function (lambda (x) (list 'Multiple-value-list x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 args))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (defmacro Multiple-value-bind (vars form &rest body)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (defmacro Multiple-value-setq (vars form)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (list 'multiple-value-setq vars (list 'Multiple-value-list form)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (defmacro Multiple-value-prog1 (form &rest body)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 ;;; Routines for parsing keyword arguments.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 (defun build-klist (arglist keys &optional allow-others)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 (or allow-others
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (let ((bad (set-difference (mapcar 'car res) keys)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 (if bad (error "Bad keywords: %s not in %s" bad keys))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 res))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (defun extract-from-klist (klist key &optional def)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (let ((res (assq key klist))) (if res (cdr res) def)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (defun keyword-argument-supplied-p (klist key)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (assq key klist))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 (defun elt-satisfies-test-p (item elt klist)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (let ((test-not (cdr (assq ':test-not klist)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (test (cdr (assq ':test klist)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (key (cdr (assq ':key klist))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 (if key (setq elt (funcall key elt)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (if test-not (not (funcall test-not item elt))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (funcall (or test 'eql) item elt))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 ;;; Rounding functions with old-style multiple value returns.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (defun cl-floor (a &optional b) (Values-list (floor* a b)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (defun cl-ceiling (a &optional b) (Values-list (ceiling* a b)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 (defun cl-round (a &optional b) (Values-list (round* a b)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 (defun cl-truncate (a &optional b) (Values-list (truncate* a b)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 (defun safe-idiv (a b)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (let* ((q (/ (abs a) (abs b)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 (s (* (signum a) (signum b))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 (Values q (- a (* s q b)) s)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 ;; Internal routines.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (defun pair-with-newsyms (oldforms)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 (Values (mapcar* 'list newsyms oldforms) newsyms)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (defun zip-lists (evens odds)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (mapcan 'list evens odds))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (defun unzip-lists (list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (let ((e nil) (o nil))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 (while list
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (Values (nreverse e) (nreverse o))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 (defun reassemble-argslists (list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 (let ((n (apply 'min (mapcar 'length list))) (res nil))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (while (>= (setq n (1- n)) 0)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 res))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (defun duplicate-symbols-p (list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 (let ((res nil))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 (while list
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (if (memq (car list) (cdr list)) (setq res (cons (car list) res)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (setq list (cdr list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 res))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 ;;; Setf internals.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (defun setnth (n list x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (setcar (nthcdr n list) x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (defun setnthcdr (n list x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (setcdr (nthcdr (1- n) list) x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 (defun setelt (seq n x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 ;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 ;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 ;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 ;;; all names with embedded `$'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 (provide 'cl-compat)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 ;;; cl-compat.el ends here
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191