view lisp/tty-init.el @ 4906:6ef8256a020a

implement equalp in C, fix case-folding, add equal() method for keymaps -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * cl-extra.el: * cl-extra.el (cl-string-vector-equalp): Removed. * cl-extra.el (cl-bit-vector-vector-equalp): Removed. * cl-extra.el (cl-vector-array-equalp): Removed. * cl-extra.el (cl-hash-table-contents-equalp): Removed. * cl-extra.el (equalp): Removed. * cl-extra.el (cl-mapcar-many): Comment out the whole `equalp' implementation for the moment; remove once we're sure the C implementation works. * cl-macs.el: * cl-macs.el (equalp): Simplify the compiler-macro for `equalp' -- once it's in C, we don't need to try so hard to expand it. src/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * abbrev.c (abbrev_match_mapper): * buffer.h (CANON_TABLE_OF): * buffer.h: * editfns.c (Fchar_equal): * minibuf.c (scmp_1): * text.c (qxestrcasecmp_i18n): * text.c (qxestrncasecmp_i18n): * text.c (qxetextcasecmp): * text.c (qxetextcasecmp_matching): Create new macro CANONCASE that converts to a canonical mapping and use it to do caseless comparisons instead of DOWNCASE. * alloc.c: * alloc.c (cons_equal): * alloc.c (vector_equal): * alloc.c (string_equal): * bytecode.c (compiled_function_equal): * chartab.c (char_table_entry_equal): * chartab.c (char_table_equal): * data.c (weak_list_equal): * data.c (weak_box_equal): * data.c (ephemeron_equal): * device-msw.c (equal_devmode): * elhash.c (hash_table_equal): * events.c (event_equal): * extents.c (properties_equal): * extents.c (extent_equal): * faces.c: * faces.c (face_equal): * faces.c (face_hash): * floatfns.c (float_equal): * fns.c: * fns.c (bit_vector_equal): * fns.c (plists_differ): * fns.c (Fplists_eq): * fns.c (Fplists_equal): * fns.c (Flax_plists_eq): * fns.c (Flax_plists_equal): * fns.c (internal_equal): * fns.c (internal_equalp): * fns.c (internal_equal_0): * fns.c (syms_of_fns): * glyphs.c (image_instance_equal): * glyphs.c (glyph_equal): * glyphs.c (glyph_hash): * gui.c (gui_item_equal): * lisp.h: * lrecord.h (struct lrecord_implementation): * marker.c (marker_equal): * number.c (bignum_equal): * number.c (ratio_equal): * number.c (bigfloat_equal): * objects.c (color_instance_equal): * objects.c (font_instance_equal): * opaque.c (equal_opaque): * opaque.c (equal_opaque_ptr): * rangetab.c (range_table_equal): * specifier.c (specifier_equal): Add a `foldcase' param to the equal() method and use it to implement `equalp' comparisons. Also add to plists_differ(), although we don't currently use it here. Rewrite internal_equalp(). Implement cross-type vector comparisons. Don't implement our own handling of numeric promotion -- just use the `=' primitive. Add internal_equal_0(), which takes a `foldcase' param and calls either internal_equal() or internal_equalp(). * buffer.h: When given a 0 for buffer (which is the norm when functions don't have a specific buffer available), use the current buffer's table, not `standard-case-table'; otherwise the current settings are ignored. * casetab.c: * casetab.c (set_case_table): When handling old-style vectors of 256 in `set-case-table' don't overwrite the existing table! Instead create a new table and populate. * device-msw.c (sync_printer_with_devmode): * lisp.h: * text.c (lisp_strcasecmp_ascii): Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use lisp_strcasecmp_i18n for caseless comparisons in some places. * elhash.c: Delete unused lisp_string_hash and lisp_string_equal(). * events.h: * keymap-buttons.h: * keymap.h: * keymap.c (keymap_lookup_directly): * keymap.c (keymap_store): * keymap.c (FROB): * keymap.c (key_desc_list_to_event): * keymap.c (describe_map_mapper): * keymap.c (INCLUDE_BUTTON_ZERO): New file keymap-buttons.h; use to handle buttons 1-26 in place of duplicating code 26 times. * frame-gtk.c (allocate_gtk_frame_struct): * frame-msw.c (mswindows_init_frame_1): Fix some comments about internal_equal() in redisplay that don't apply any more. * keymap-slots.h: * keymap.c: New file keymap-slots.h. Use it to notate the slots in a keymap structure, similar to frameslots.h or coding-system-slots.h. * keymap.c (MARKED_SLOT): * keymap.c (keymap_equal): * keymap.c (keymap_hash): Implement. tests/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * automated/case-tests.el: * automated/case-tests.el (uni-mappings): * automated/search-tests.el: Delete old pristine-case-table code. Rewrite the Unicode torture test to take into account whether overlapping mappings exist for more than one character, and not doing the upcase/downcase comparisons in such cases. * automated/lisp-tests.el (foo): * automated/lisp-tests.el (string-variable): * automated/lisp-tests.el (featurep): Replace Assert (equal ... with Assert-equal; same for other types of equality. Replace some awkward equivalents of Assert-equalp with Assert-equalp. Add lots of equalp tests. * automated/case-tests.el: * automated/regexp-tests.el: * automated/search-tests.el: Fix up the comments at the top of the files. Move rules about where to put tests into case-tests.el. * automated/test-harness.el: * automated/test-harness.el (test-harness-aborted-summary-template): New. * automated/test-harness.el (test-harness-from-buffer): * automated/test-harness.el (batch-test-emacs): Fix Assert-test-not. Create Assert-not-equal and variants. Delete the doc strings from all these convenience functions to avoid excessive repetition; instead use one copy in a comment.
author Ben Wing <ben@xemacs.org>
date Mon, 01 Feb 2010 01:02:40 -0600
parents c786c3fd0740
children 308d34e9f07d
line wrap: on
line source

;;; tty-init.el --- initialization code for tty's

;; Copyright (C) 1994, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1996 Ben Wing <ben@xemacs.org>.

;; Maintainer: XEmacs Development Team
;; Keywords: terminals, 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: Not synched.

;;; Commentary:

;; This file is dumped with XEmacs (when TTY support is compiled in).

;;; Code:

(defvar make-device-early-tty-entry-point-called-p nil
  "Whether `make-device-early-tty-entry-point' has been called, at least once.")

(defun make-device-early-tty-entry-point ()
  "Entry point to set up the Lisp environment for TTY device creation."
  (with-fboundp 'register-tty-color
    (unless make-device-early-tty-entry-point-called-p
      (register-tty-color "black"   "\e[30m" "\e[40m")
      (register-tty-color "red"     "\e[31m" "\e[41m")
      (register-tty-color "green"   "\e[32m" "\e[42m")
      (register-tty-color "yellow"  "\e[33m" "\e[43m")
      (register-tty-color "blue"    "\e[34m" "\e[44m")
      (register-tty-color "magenta" "\e[35m" "\e[45m")
      (register-tty-color "cyan"    "\e[36m" "\e[46m")
      (register-tty-color "white"   "\e[37m" "\e[47m")

      ;; Define `highlighted' tty colors
      (register-tty-color "darkgrey"      "\e[1;30m" "\e[1;40m")
      (register-tty-color "brightred"     "\e[1;31m" "\e[1;41m")
      (register-tty-color "brightgreen"   "\e[1;32m" "\e[1;42m")
      (register-tty-color "brightyellow"  "\e[1;33m" "\e[1;43m")
      (register-tty-color "brightblue"    "\e[1;34m" "\e[1;44m")
      (register-tty-color "brightmagenta" "\e[1;35m" "\e[1;45m")
      (register-tty-color "brightcyan"    "\e[1;36m" "\e[1;46m")
      (register-tty-color "brightwhite"   "\e[1;37m" "\e[1;47m")

      (setq make-device-early-tty-entry-point-called-p t))))

;; We have to do this for every created TTY console, after the first frame
;; has been created.
(defun make-frame-after-init-entry-point (console)
  "Entry point for Lisp called after first frame creation on a TTY device."
  ;; load the appropriate term-type-specific Lisp file.
  ;; we don't do this at startup here so that the user can
  ;; override term-file-prefix. (startup.el does it after
  ;; loading the init file.)
  (when (and (find-coding-system 'euc-jp)
             (string-match "^kterm" (getenv "TERM")))
    (set-console-tty-coding-system console 'euc-jp))
  (when init-file-loaded
    ;; temporarily select the console so that the changes
    ;; to function-key-map are made for the right console.
    (let ((foobar (selected-console)))
      (unwind-protect
	  (progn
	    (select-console console)
	    (load-terminal-library))
	(select-console foobar)))))

(defun make-frame-on-tty (tty &optional props)
  "Create a frame on the TTY connection named TTY.
TTY should be a TTY device name such as \"/dev/ttyp3\" (as returned by
the `tty' command in that TTY), or nil for the standard input/output
of the running XEmacs process.

PROPS should be a plist of properties, as in the call to `make-frame'.

This function opens a connection to the TTY or reuses an existing
connection.

This function is a trivial wrapper around `make-frame-on-device'."
  (interactive "sMake frame on TTY: ")
  (if (equal tty "") (setq tty nil))
  (make-frame-on-device 'tty tty props))

;;; tty-init.el ends here