Move the various map* functions to C; add #'map-into. src/ChangeLog addition: 2010-01-31 Aidan Kehoe <kehoea@parhasard.net> Move #'mapcar*, #'mapcan, #'mapc, #'map, #'mapl, #'mapcon to C; extend #'mapvector, #'mapconcat, #'mapcar to support more SEQUENCES; have them all error with circular lists. * fns.c (Fsubseq): Call CHECK_SEQUENCE here; Flength can return from the debugger if it errors with a non-sequence, leading to a crash in Fsubseq if sequence really is *not* a sequence. (mapcarX): Rename mapcar1 to mapcarX; rework it comprehensively to take an optional lisp output argument, and a varying number of sequences. Special-case a single list argument, as we used to, saving its elements in the stack space for the results before calling FUNCTION, so FUNCTION can corrupt the list all it wants. dead_wrong_type_argument() in the other cases if we encounter a non-cons where we expected a cons. (Fmapconcat): Accept further SEQUENCES after separator here. Special-case the idiom (mapconcat 'identity SEQUENCE), don't even funcall. (FmapcarX): Rename this from Fmapcar. Accept optional SEQUENCES. (Fmapvector): Accept optional SEQUENCES. (Fmapcan, Fmapc, Fmap): Move these here from cl-extra.el. (Fmap_into): New function, as specified by Common Lisp. (maplist): New function, the guts of the implementation of Fmaplist and Fmapl. (Fmaplist, Fmapl, Fmapcon): Move these from cl-extra.el. (syms_of_fns): Add a few needed symbols here, for the type tests used by #'map. Add the new subrs, with aliases for #'mapc-internal and #'mapcar. * general-slots.h: Declare Qcoerce here, now it's used in both indent.c and fns.c * indent.c (syms_of_indent): Qcoerce is gone from here. * lisp.h: Add ARRAYP(), SEQUENCEP(), and the corresponding CHECK_* macros. Declare Fbit_vector, Fstring, FmapcarX, now other files need to use them. * data.c (Farrayp, Fsequencep): Use ARRAYP and SEQUENCEP, just added to lisp.h * buffer.c (Fbuffer_list): Now Fmapcar has been renamed FmapcarX and takes MANY arguments, update this function to reflect that. lisp/ChangeLog addition: 2010-01-31 Aidan Kehoe <kehoea@parhasard.net> * cl.el (mapcar*): Delete; this is now in fns.c. Use #'mapc, not #'mapc-internal in a couple of places. * cl-macs.el (mapc, mapcar*, map): Delete these compiler macros now the corresponding functions are in fns.c; there's no run-time advantage to the macros. * cl-extra.el (coerce): Extend the possible conversions here a little; it's not remotely comprehensive yet, though it does allow running slightly more Common Lisp code than previously. (cl-mapcar-many): Delete. (map, maplist, mapc, mapl, mapcan, mapcon): Move these to fns.c. * bytecomp.el (byte-compile-maybe-mapc): Use #'mapc itself, not #'mapc-internal, now the former is in C. (mapcar*): Use #'byte-compile-maybe-mapc as this function's byte-compile method, now a #'mapc that can take more than one sequence is in C. * obsolete.el (cl-mapc): Move this compatibility alias to this file. * update-elc.el (do-autoload-commands): Use #'mapc, not #'mapc-internal here.

;;; misc.el --- miscellaneous functions for XEmacs

;; Copyright (C) 1989, 1997 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: extensions, dumped

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: FSF 19.34.

;;; Commentary:

;; This file is dumped with XEmacs.

;; 06/11/1997 - Use char-(after|before) instead of
;;  (following|preceding)-char. -slb

;;; Code:

(defun copy-from-above-command (&optional arg)
  "Copy characters from previous nonblank line, starting just above point.
Copy ARG characters, but not past the end of that line.
If no argument given, copy the entire rest of the line.
The characters copied are inserted in the buffer before point."
  (interactive "P")
  (let ((cc (current-column))
	n
	(string ""))
    (save-excursion
      (beginning-of-line)
      (backward-char 1)
      (skip-chars-backward "\ \t\n")
      (move-to-column cc)
      ;; Default is enough to copy the whole rest of the line.
      (setq n (if arg (prefix-numeric-value arg) (point-max)))
      ;; If current column winds up in middle of a tab,
      ;; copy appropriate number of "virtual" space chars.
      (if (< cc (current-column))
	  (if (eq (char-before (point)) ?\t)
	      (progn
		(setq string (make-string (min n (- (current-column) cc)) ?\ ))
		(setq n (- n (min n (- (current-column) cc)))))
	    ;; In middle of ctl char => copy that whole char.
	    (backward-char 1)))
      (setq string (concat string
			   (buffer-substring
			    (point)
			    (min (save-excursion (end-of-line) (point))
				 (+ n (point)))))))
    (insert string)))

;;; misc.el ends here