Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1130

Internet Message Format | 1990-12-28 | 46.0 KB

From: [e-mail] (Howard Gayle)
Newsgroups: alt.sources
Subject: GNU Emacs 8-bit mods part 03 of 12
Message-ID: <[e-mail]>
Date: 5 Apr 90 13:34:16 GMT

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to [e-mail] if you want that tool.
# If this archive is complete, you will see the following message at the end:
#        "End of archive 3 (of 4)."
# Contents:  lisp/case-table.el lisp/char-table.el lisp/emphasis.el
#   lisp/iso8859-1-ascii.el lisp/term/fa4440a.el lisp/term/fa4440b.el
#   src/casetab.c src/etctab.h
# Wrapped by howard@hasse on Thu Apr  5 15:28:05 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'lisp/case-table.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lisp/case-table.el'\"
else
echo shar: Extracting \"'lisp/case-table.el'\" \(6932 characters\)
sed "s/^X//" >'lisp/case-table.el' <<'END_OF_FILE'
X;; Functions for extending the character set and dealing with case tables.
X;; Copyright (C) 1987, 1990 Free Software Foundation, Inc.
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X
X;; Written by:
X;; Howard Gayle
X;; TN/ETX/TT/HL
X;; Ericsson Telecom AB
X;; S-126 25 Stockholm
X;; Sweden
X;; [e-mail]
X;; uunet!ericsson.se!howard
X;; Phone: [phone]
X;; FAX  : [phone]
X
X(require 'text-mode)
X
X(defun case-of (ch ct)
X   "Return 'nocase if character CH is marked as caseless in
Xcase table CT, 'lowercase for lower case, and 'uppercase for
Xupper case."
X   (cond
X      ((nocase-p ch ct) 'nocase)
X      ((lower-p  ch ct) 'lowercase)
X      (t                'uppercase)
X   )
X)
X
X(defun describe-buffer-case-table ()
X   "Describe the case table of the current buffer."
X   (interactive)
X   (describe-case-table (case-table))
X)
X
X(defun describe-case-table (ct)
X   "Describe the given case table in a help buffer."
X   (let* (
X           (i 0)                   ; First character in range.
X     (ic (case-of 0 ct)) ; Case of i.
X     (j 0)                   ; Last character in range.
X     (jc ic)              ; Case of j.
X     (k 1)                   ; Current character.
X     kc                      ; Case of k.
X           )
X      (with-output-to-temp-buffer "*Help*"
X     (while (<= k 255)
X        (setq kc (case-of k ct))
X        (if (not (eq jc kc))
X           (progn
X          (describe-character i)
X          (if (not (= i j))
X             (progn
X                 (princ "..")
X            (describe-character j)
X             )
X          )
X          (princ "\t")
X          (princ (symbol-name jc))
X          (princ "\n")
X          (setq i k)
X          (setq ic kc)
X           )
X        )
X        (if (= k 255)
X           (progn
X          (describe-character i)
X          (if (not (= i k))
X             (progn
X                 (princ "..")
X            (describe-character k)
X             )
X          )
X          (princ "\t")
X          (princ (symbol-name kc))
X          (princ "\n")
X           )
X        )
X        (setq j k)
X        (setq jc kc)
X        (setq k (1+ k))
X     )
X     (print-help-return-message)
X      )
X   )
X)
X
X(defun describe-character (c)
X   "Print character C readably."
X   (cond
X      ((= c ?\t) (princ "\\t"))
X      ((= c ?\n) (princ "\\n"))
X      (t (princ (char-to-string c)))
X   )
X)
X
X(defun invert-case ()
X   "Change the case of the character just after point."
X   (interactive "*")
X   (let  (
X           (oc (following-char)) ; Old character.
X           )
X      (cond
X           ((lower-p oc) (replace-char (upcase   oc)))
X           ((upper-p oc) (replace-char (downcase oc)))
X      )
X   )
X   (forward-char)
X)
X
X(defun standard-case-syntax-delims (l r)
X   "Set the entries for characters L and R in standard-case-table,
Xstandard-downcase-table, standard-upcase-table,
Xstandard-syntax-table, and text-mode-syntax-table to indicate
Xleft and right delimiters."
X   (set-case-table-nocase l (standard-case-table))
X   (set-case-table-nocase r (standard-case-table))
X   (set-trans-table-to l l (standard-downcase-table))
X   (set-trans-table-to r r (standard-downcase-table))
X   (set-trans-table-to l l (standard-upcase-table))
X   (set-trans-table-to r r (standard-upcase-table))
X   (modify-syntax-entry l
X      (concat "(" (char-to-string r) "  ") (standard-syntax-table))
X   (modify-syntax-entry l
X      (concat "(" (char-to-string r) "  ") text-mode-syntax-table)
X   (modify-syntax-entry r
X      (concat ")" (char-to-string l) "  ") (standard-syntax-table))
X   (modify-syntax-entry r
X      (concat ")" (char-to-string l) "  ") text-mode-syntax-table)
X)
X
X(defun standard-case-syntax-pair (uc lc)
X   "Set the entries for characters UC and LC in
Xstandard-case-table, standard-downcase-table,
Xstandard-upcase-table, standard-case-fold-table, standard-syntax-table, and
Xtext-mode-syntax-table to indicate an (uppercase, lowercase)
Xpair of letters."
X   (set-case-table-pair lc uc (standard-case-table))
X   (set-trans-table-to lc lc (standard-downcase-table))
X   (set-trans-table-to uc lc (standard-downcase-table))
X   (set-trans-table-to lc uc (standard-upcase-table))
X   (set-trans-table-to uc uc (standard-upcase-table))
X   (modify-syntax-entry lc "w   " (standard-syntax-table))
X   (modify-syntax-entry lc "w   " text-mode-syntax-table)
X   (modify-syntax-entry uc "w   " (standard-syntax-table))
X   (modify-syntax-entry uc "w   " text-mode-syntax-table)
X)
X
X(defun standard-case-syntax-punct (c)
X   "Set the entries for character C in standard-case-table,
Xstandard-downcase-table, standard-upcase-table,
Xstandard-syntax-table, and text-mode-syntax-table to indicate
Xpunctuation."
X   (set-case-table-nocase c (standard-case-table))
X   (set-trans-table-to c c (standard-downcase-table))
X   (set-trans-table-to c c (standard-upcase-table))
X   (modify-syntax-entry c ".   " (standard-syntax-table))
X   (modify-syntax-entry c ".   " text-mode-syntax-table)
X)
X
X(defun standard-case-syntax-symb (c)
X   "Set the entries for character C in standard-case-table,
Xstandard-downcase-table, standard-upcase-table,
Xstandard-syntax-table, and text-mode-syntax-table to indicate a
Xsymbol."
X   (set-case-table-nocase c (standard-case-table))
X   (set-trans-table-to c c (standard-downcase-table))
X   (set-trans-table-to c c (standard-upcase-table))
X   (modify-syntax-entry c "_   " (standard-syntax-table))
X   (modify-syntax-entry c "_   " text-mode-syntax-table)
X)
X
X(defun standard-case-syntax-white (c)
X   "Set the entries for character C in standard-case-table,
Xstandard-downcase-table, standard-upcase-table,
Xstandard-syntax-table, and text-mode-syntax-table to indicate
Xwhite space."
X   (set-case-table-nocase c (standard-case-table))
X   (set-trans-table-to c c (standard-downcase-table))
X   (set-trans-table-to c c (standard-upcase-table))
X   (modify-syntax-entry c "    " (standard-syntax-table))
X   (modify-syntax-entry c "    " text-mode-syntax-table)
X)
X
X(defun standard-case-syntax-word (c)
X   "Set the entries for character C in standard-case-table,
Xstandard-downcase-table, standard-upcase-table,
Xstandard-syntax-table, and text-mode-syntax-table to indicate a
Xword component."
X   (set-case-table-nocase c (standard-case-table))
X   (set-trans-table-to c c (standard-downcase-table))
X   (set-trans-table-to c c (standard-upcase-table))
X   (modify-syntax-entry c "w   " (standard-syntax-table))
X   (modify-syntax-entry c "w   " text-mode-syntax-table)
X)
X
X(provide 'case-table)
END_OF_FILE
if test 6932 -ne `wc -c <'lisp/case-table.el'`; then
    echo shar: \"'lisp/case-table.el'\" unpacked with wrong size!
fi
# end of 'lisp/case-table.el'
fi
if test -f 'lisp/char-table.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lisp/char-table.el'\"
else
echo shar: Extracting \"'lisp/char-table.el'\" \(5206 characters\)
sed "s/^X//" >'lisp/char-table.el' <<'END_OF_FILE'
X;; Functions for dealing with char tables.
X;; Copyright (C) 1987 Free Software Foundation, Inc.
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X
X;; Written by Howard Gayle.  See case-table.el for details.
X
X(require 'case-table)
X
X(defun buffer-ctl-arrow-off ()
X   "Display control characters as \\ number in curent buffer.
XDoes not change existing windows."
X   (interactive)
X   (setq buffer-char-table (backslash-char-table))
X)
X
X(defun buffer-ctl-arrow-on ()
X   "Display control characters as ^ character in curent buffer.
XDoes not change existing windows."
X   (interactive)
X   (setq buffer-char-table (ctl-arrow-char-table))
X)
X
X(defun ctl-arrow-off ()
X   "Display control characters as \\ number in selected window."
X   (interactive)
X   (set-window-char-table (backslash-char-table))
X)
X
X(defun ctl-arrow-on ()
X   "Display control characters as ^ character in selected window."
X   (interactive)
X   (set-window-char-table (ctl-arrow-char-table))
X)
X
X(defun default-ctl-arrow-off ()
X   "By default, display control characters as \\ number."
X   (interactive)
X   (setq-default buffer-char-table (backslash-char-table))
X)
X
X(defun default-ctl-arrow-on ()
X   "By default, display control characters as ^ character."
X   (interactive)
X   (setq-default buffer-char-table (ctl-arrow-char-table))
X)
X
X(defun describe-char-table (ct)
X   "Describe the given char table in a help buffer."
X   (let  (
X           (i 0) ; Current character.
X     j     ; Rope index.
X     r     ; Rope.
X     )
X      (with-output-to-temp-buffer "*Help*"
X     (princ "Frame glyf: ")
X     (prin1 (glyf-to-string (get-char-table-frameg ct)))
X     (princ "\nTruncation glyf: ")
X     (prin1 (glyf-to-string (get-char-table-truncg ct)))
X     (princ "\nWrap glyf: ")
X     (prin1 (glyf-to-string (get-char-table-wrapg ct)))
X           (princ "\nSelective display character: ")
X     (describe-character (get-char-table-invisc ct))
X     (princ "\nSelective display rope: ")
X     (setq r (get-char-table-invisr ct))
X     (setq j 0)
X     (while (< j (length r))
X        (aset r j (glyf-to-string (aref r j)))
X        (setq j (1+ j))
X     )
X     (prin1 r)
X     (princ "\n\nCharacter ropes:\n")
X     (while (<= i 255)
X        (describe-character i)
X        (princ "\t")
X        (setq r (get-char-table-dispr ct i))
X        (setq j 0)
X        (while (< j (length r))
X           (aset r j (glyf-to-string (aref r j)))
X           (setq j (1+ j))
X        )
X        (prin1 r)
X        (princ "\n")
X        (setq i (1+ i))
X     )
X     (print-help-return-message)
X      )
X   )
X)
X
X(defun describe-window-char-table ()
X   "Describe the char table of the selected window."
X   (interactive)
X   (describe-char-table (window-char-table (selected-window)))
X)
X
X(defun standard-chars-8bit (l h)
X   "Display characters in the range [L, H] with their actual
Xvalues in backslash-char-table and ctl-arrow-char-table."
X   (let     (r)
X      (while (<= l h)
X           (setq r (vector (new-glyf (char-to-string l))))
X     (put-char-table-dispr (backslash-char-table) l r)
X     (put-char-table-dispr (ctl-arrow-char-table) l r)
X     (setq l (1+ l))
X      )
X      r
X   )
X)
X
X(defun standard-char-ascii (c s)
X   "Display character C with string S in
X   backslash-char-table and ctl-arrow-char-table."
X   (let     ((r (string-to-rope s)))
X      (put-char-table-dispr (backslash-char-table) c r)
X      (put-char-table-dispr (ctl-arrow-char-table) c r)
X   )
Xc
X)
X
X(defun standard-char-g1 (c sc)
X   "Display character C as G1 character SC in
X   backslash-char-table and ctl-arrow-char-table."
X   (let     ((r (vector (new-glyf (concat "\016" (char-to-string sc) "\017")))))
X      (put-char-table-dispr (backslash-char-table) c r)
X      (put-char-table-dispr (ctl-arrow-char-table) c r)
X      r
X   )
X)
X
X(defun string-to-rope (s)
X   "Convert string S to a rope with 1 glyf for each character."
X   (let* (
X         (l (length s))
X         (r (make-vector l nil)) ; The rope.
X         (i 0)                   ; Index.
X         )
X      (while (/= i l)
X         (aset r i (get-glyf (char-to-string (aref s i))))
X         (setq i (1+ i))
X      )
X      r
X   )
X)
X
X(defun toggle-ctl-arrow ()
X   "Toggle display of control characters in selected window."
X   (interactive)
X   (if (eq (window-char-table) (ctl-arrow-char-table))
X      (ctl-arrow-off)
X      (ctl-arrow-on)
X   )
X)
X
X(defun toggle-default-ctl-arrow ()
X   "Toggle default display of control characters."
X   (interactive)
X   (if (eq (default-value 'buffer-char-table) (ctl-arrow-char-table))
X      (default-ctl-arrow-off)
X      (default-ctl-arrow-on)
X   )
X)
X
X(provide 'char-table)
END_OF_FILE
if test 5206 -ne `wc -c <'lisp/char-table.el'`; then
    echo shar: \"'lisp/char-table.el'\" unpacked with wrong size!
fi
# end of 'lisp/char-table.el'
fi
if test -f 'lisp/emphasis.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lisp/emphasis.el'\"
else
echo shar: Extracting \"'lisp/emphasis.el'\" \(5605 characters\)
sed "s/^X//" >'lisp/emphasis.el' <<'END_OF_FILE'
X;; Display characters with emphasis.
X;; Copyright (C) 1987 Free Software Foundation, Inc.
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X
X;; Written by Howard Gayle.  See case-table.el for details.
X
X;; This file uses the char table stuff to display characters
X;; with emphasis, e.g. underlined.  The high order bit is set for
X;; emphasis.  This implies a 7-bit character set, so this file
X;; will not mix with ISO 8859.
X
X(defvar emphasis-char-table nil "Char table where high bit set for emphasis.")
X
X(defvar deemphasize-trans-table nil "Trans table to set high bit.")
X(if deemphasize-trans-table nil
X   (setq deemphasize-trans-table (make-trans-table))
X   (let     (
X           (i 128)
X     )
X      (while (<= i 255)
X           (set-trans-table-to i (- i 128) deemphasize-trans-table)
X           (setq i (1+ i))
X      )
X   )
X)
X
X(defvar emphasize-trans-table nil "Trans table to set high bit.")
X(if emphasize-trans-table nil
X   (setq emphasize-trans-table (make-trans-table))
X   (let     (
X           (i 32)
X     )
X      (while (<= i 127)
X           (set-trans-table-to i (+ i 128) emphasize-trans-table)
X           (setq i (1+ i))
X      )
X   )
X)
X
X(defvar start-emphasis nil "Bytes to terminal to start emphasis.")
X(defvar stop-emphasis  nil "Bytes to terminal to stop emphasis.")
X
X(defun emphasis-on ()
X   "Use emphasis char table in selected window, if possible."
X   (interactive)
X   (init-emphasis-char-table-maybe)
X   (if emphasis-char-table (set-window-char-table emphasis-char-table))
X)
X
X(defun deemphasize-region (b e)
X   "Emphasize the characters in region."
X   (interactive "*r")
X   (translate-region b e deemphasize-trans-table)
X)
X
X
X(defun emphasize-manual-entry ()
X   "Convert backspace underlining and overstriking to emphasis
Xin the current buffer."
X   (interactive)
X   (let  (
X           (buffer-read-only nil)
X     )
X      (init-emphasis-char-table-maybe)
X      (if (and emphasis-char-table
X                 (underline-to-emphasis-region (point-min) (point-max)))
X           (setq buffer-char-table emphasis-char-table)
X      )
X   )
X)
X
X(setq manual-entry-hook 'emphasize-manual-entry)
X
X(defun emphasize-region (b e)
X   "Emphasize the characters in region."
X   (interactive "*r")
X   (translate-region b e emphasize-trans-table)
X)
X
X(defun init-emphasis-char-table ()
X   "Initialize emphasis char table."
X   (interactive)
X   (setq emphasis-char-table (copy-char-table))
X   (let  (
X     (i 0) ; Current character.
X     j     ; Rope index.
X     r     ; Rope.
X     )
X      (while (<= i 127)
X     (setq r (get-char-table-dispr emphasis-char-table i))
X     (setq j 0)
X     (while (< j (length r))
X        (aset r j (get-glyf (concat start-emphasis
X                    (glyf-to-string (aref r j))
X                    stop-emphasis)))
X        (setq j (1+ j))
X     )
X     (put-char-table-dispr emphasis-char-table (+ i 128) r)
X     (setq i (1+ i))
X      )
X   )
X)
X
X(defun init-emphasis-char-table-maybe ()
X   "Initialize emphasis char table if necessary."
X   (cond
X      (emphasis-char-table)
X      ((or (not (stringp start-emphasis))
X     (not (stringp stop-emphasis)))
X     (message "start-emphasis and stop-emphasis must be set."))
X      (t
X     (message "Making emphasis char table...")
X     (init-emphasis-char-table)
X     (message "Making emphasis char table...done")
X      )
X   )
X)
X
X(defun underline-to-emphasis-buffer ()
X   "Convert backspace underlining and overstriking to emphasis
Xin the current buffer."
X   (interactive)
X   (let  (
X           (buffer-read-only nil)
X     )
X      (if (underline-to-emphasis-region (point-min) (point-max))
X           (emphasis-on)
X      )
X   )
X)
X
X(defun underline-to-emphasis-region (b e)
X   "Convert backspace underlining and overstriking to emphasis
Xin the region.  Returns t iff any changes made."
X   (interactive "*r")
X   (let     (
X           (em (make-marker)) ; End marker.
X     fc                     ; Character following backspace.
X     pc                     ; Character preceding backspace.
X     tmp                    ; Temporary.
X     z                      ; Return.
X           )
X      (if (< e b)
X           (progn
X        (setq tmp b)
X        (setq b e)
X        (setq e tmp)
X     )
X      )
X      (move-marker em e)
X      (save-excursion
X           (goto-char b)
X           (while (search-forward "\b" em t)
X              (setq pc (char-after (- (point) 2)))
X        (setq fc (following-char))
X        (cond
X           ((= pc ?_)
X          (forward-char 1)
X          (delete-char -3)
X          (insert (get-trans-table-to fc emphasize-trans-table))
X          (setq z t)
X           )
X           ((= fc ?_)
X          (forward-char 1)
X          (delete-char -3)
X          (insert (get-trans-table-to pc emphasize-trans-table))
X          (setq z t)
X           )
X           ((= pc fc)
X                 (setq tmp (- (point) 2))
X          (forward-char 1)
X          (while (and (= (following-char) ?\b)
X                  (= (char-after (1+ (point))) pc))
X             (forward-char 2)
X          )
X          (delete-region tmp (point))
X          (insert (get-trans-table-to pc emphasize-trans-table))
X          (setq z t)
X           )
X        )
X     )
X      )
X      z
X   )
X)
X
X(provide 'emphasis)
END_OF_FILE
if test 5605 -ne `wc -c <'lisp/emphasis.el'`; then
    echo shar: \"'lisp/emphasis.el'\" unpacked with wrong size!
fi
# end of 'lisp/emphasis.el'
fi
if test -f 'lisp/iso8859-1-ascii.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lisp/iso8859-1-ascii.el'\"
else
echo shar: Extracting \"'lisp/iso8859-1-ascii.el'\" \(6663 characters\)
sed "s/^X//" >'lisp/iso8859-1-ascii.el' <<'END_OF_FILE'
X;; Set up char tables for ISO 8859/1 character set for ASCII terminals.
X;; Copyright (C) 1987 Free Software Foundation, Inc.
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X
X;; Written by Howard Gayle.  See case-table.el for details.
X
X;; This code sets up backslash-char-table and
X;; ctl-arrow-char-table to display ISO 8859/1 characters on plain
X;; ASCII terminals.  The display strings for the characters are
X;; more-or-less based on TeX.
X
X(require 'char-table)
X
X(standard-char-ascii 160 "{_}")   ; NBSP (no-break space)
X(standard-char-ascii 161 "{!}")   ; inverted exclamation mark
X(standard-char-ascii 162 "{c}")   ; cent sign
X(standard-char-ascii 163 "{GBP}") ; pound sign
X(standard-char-ascii 164 "{$}")   ; general currency sign
X(standard-char-ascii 165 "{JPY}") ; yen sign
X(standard-char-ascii 166 "{|}")   ; broken vertical line
X(standard-char-ascii 167 "{S}")   ; section sign
X(standard-char-ascii 168 "{\"}")  ; diaeresis
X(standard-char-ascii 169 "{C}")   ; copyright sign
X(standard-char-ascii 170 "{_a}")  ; ordinal indicator, feminine
X(standard-char-ascii 171 "{<<}")  ; left angle quotation mark
X(standard-char-ascii 172 "{~}")   ; not sign
X(standard-char-ascii 173 "{-}")   ; soft hyphen
X(standard-char-ascii 174 "{R}")   ; registered sign
X(standard-char-ascii 175 "{=}")   ; macron
X(standard-char-ascii 176 "{o}")   ; degree sign
X(standard-char-ascii 177 "{+-}")  ; plus or minus sign
X(standard-char-ascii 178 "{2}")   ; superscript two
X(standard-char-ascii 179 "{3}")   ; superscript three
X(standard-char-ascii 180 "{'}")   ; acute accent
X(standard-char-ascii 181 "{u}")   ; micro sign
X(standard-char-ascii 182 "{P}")   ; pilcrow
X(standard-char-ascii 183 "{.}")   ; middle dot
X(standard-char-ascii 184 "{,}")   ; cedilla
X(standard-char-ascii 185 "{1}")   ; superscript one
X(standard-char-ascii 186 "{_o}")  ; ordinal indicator, masculine
X(standard-char-ascii 187 "{>>}")  ; right angle quotation mark
X(standard-char-ascii 188 "{1/4}") ; fraction one-quarter
X(standard-char-ascii 189 "{1/2}") ; fraction one-half
X(standard-char-ascii 190 "{3/4}") ; fraction three-quarters
X(standard-char-ascii 191 "{?}")   ; inverted question mark
X(standard-char-ascii 192 "{`A}")  ; A with grave accent
X(standard-char-ascii 193 "{'A}")  ; A with acute accent
X(standard-char-ascii 194 "{^A}")  ; A with circumflex accent
X(standard-char-ascii 195 "{~A}")  ; A with tilde
X(standard-char-ascii 196 "{\"A}") ; A with diaeresis or umlaut mark
X(standard-char-ascii 197 "{AA}")  ; A with ring
X(standard-char-ascii 198 "{AE}")  ; AE diphthong
X(standard-char-ascii 199 "{,C}")  ; C with cedilla
X(standard-char-ascii 200 "{`E}")  ; E with grave accent
X(standard-char-ascii 201 "{'E}")  ; E with acute accent
X(standard-char-ascii 202 "{^E}")  ; E with circumflex accent
X(standard-char-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark
X(standard-char-ascii 204 "{`I}")  ; I with grave accent
X(standard-char-ascii 205 "{'I}")  ; I with acute accent
X(standard-char-ascii 206 "{^I}")  ; I with circumflex accent
X(standard-char-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark
X(standard-char-ascii 208 "{-D}")  ; D with stroke, Icelandic eth
X(standard-char-ascii 209 "{~N}")  ; N with tilde
X(standard-char-ascii 210 "{`O}")  ; O with grave accent
X(standard-char-ascii 211 "{'O}")  ; O with acute accent
X(standard-char-ascii 212 "{^O}")  ; O with circumflex accent
X(standard-char-ascii 213 "{~O}")  ; O with tilde
X(standard-char-ascii 214 "{\"O}") ; O with diaeresis or umlaut mark
X(standard-char-ascii 215 "{x}")   ; multiplication sign
X(standard-char-ascii 216 "{/O}")  ; O with slash
X(standard-char-ascii 217 "{`U}")  ; U with grave accent
X(standard-char-ascii 218 "{'U}")  ; U with acute accent
X(standard-char-ascii 219 "{^U}")  ; U with circumflex accent
X(standard-char-ascii 220 "{\"U}") ; U with diaeresis or umlaut mark
X(standard-char-ascii 221 "{'Y}")  ; Y with acute accent
X(standard-char-ascii 222 "{TH}")  ; capital thorn, Icelandic
X(standard-char-ascii 223 "{ss}")  ; small sharp s, German
X(standard-char-ascii 224 "{`a}")  ; a with grave accent
X(standard-char-ascii 225 "{'a}")  ; a with acute accent
X(standard-char-ascii 226 "{^a}")  ; a with circumflex accent
X(standard-char-ascii 227 "{~a}")  ; a with tilde
X(standard-char-ascii 228 "{\"a}") ; a with diaeresis or umlaut mark
X(standard-char-ascii 229 "{aa}")  ; a with ring
X(standard-char-ascii 230 "{ae}")  ; ae diphthong
X(standard-char-ascii 231 "{,c}")  ; c with cedilla
X(standard-char-ascii 232 "{`e}")  ; e with grave accent
X(standard-char-ascii 233 "{'e}")  ; e with acute accent
X(standard-char-ascii 234 "{^e}")  ; e with circumflex accent
X(standard-char-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark
X(standard-char-ascii 236 "{`i}")  ; i with grave accent
X(standard-char-ascii 237 "{'i}")  ; i with acute accent
X(standard-char-ascii 238 "{^i}")  ; i with circumflex accent
X(standard-char-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark
X(standard-char-ascii 240 "{-d}")  ; d with stroke, Icelandic eth
X(standard-char-ascii 241 "{~n}")  ; n with tilde
X(standard-char-ascii 242 "{`o}")  ; o with grave accent
X(standard-char-ascii 243 "{'o}")  ; o with acute accent
X(standard-char-ascii 244 "{^o}")  ; o with circumflex accent
X(standard-char-ascii 245 "{~o}")  ; o with tilde
X(standard-char-ascii 246 "{\"o}") ; o with diaeresis or umlaut mark
X(standard-char-ascii 247 "{/}")   ; division sign
X(standard-char-ascii 248 "{/o}")  ; o with slash
X(standard-char-ascii 249 "{`u}")  ; u with grave accent
X(standard-char-ascii 250 "{'u}")  ; u with acute accent
X(standard-char-ascii 251 "{^u}")  ; u with circumflex accent
X(standard-char-ascii 252 "{\"u}") ; u with diaeresis or umlaut mark
X(standard-char-ascii 253 "{'y}")  ; y with acute accent
X(standard-char-ascii 254 "{th}")  ; small thorn, Icelandic
X(standard-char-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark
X
X(provide 'iso8859-1-ascii)
END_OF_FILE
if test 6663 -ne `wc -c <'lisp/iso8859-1-ascii.el'`; then
    echo shar: \"'lisp/iso8859-1-ascii.el'\" unpacked with wrong size!
fi
# end of 'lisp/iso8859-1-ascii.el'
fi
if test -f 'lisp/term/fa4440a.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lisp/term/fa4440a.el'\"
else
echo shar: Extracting \"'lisp/term/fa4440a.el'\" \(4902 characters\)
sed "s/^X//" >'lisp/term/fa4440a.el' <<'END_OF_FILE'
X;;; Set up Facit 4440 (Twist) terminal.
X
X;; Map Twist function key escape sequences
X;; into the standard slots in function-keymap.
X
X(require 'keypad)
X
X(keypad-default "p" 'redraw-screen-72-lines)
X(keypad-default "q" 'redraw-screen-24-lines)
X
X(defvar CSI-map nil
X  "The CSI-map maps the CSI function keys on the Twist keyboard.
XThe CSI keys are the arrow keys.")
X
X(if (not CSI-map)
X    (progn
X     (setq CSI-map (lookup-key global-map "\e["))
X     (if (not (keymapp CSI-map))
X     (setq CSI-map (make-sparse-keymap)))  ;; <ESC>[ commands
X     (setup-terminal-keymap CSI-map '(
X        ("A"   . ?u) ; up arrow
X    ("B"   . ?d) ; down-arrow
X    ("C"   . ?r) ; right-arrow
X    ("D"   . ?l) ; left-arrow
X    ("H"   . ?h) ; home
X    ("J"   . ?C) ; shift-erase = clear screen
X    ("K"   . ?c) ; erase
X    ("L"   . ?A) ; insert line
X    ("M"   . ?L) ; delete line
X    ("P"   . ?D) ; delete character
X    ("U"   . ?N) ; shift-down-arrow = next page
X    ("V"   . ?P) ; shift-up-arrow = previous page
X    ("X"   . ?H) ; shift-home = home-down
X    ("Z"   . ?b) ; tabulation backward
X    ("4h"  . ?I) ; insert character
X    ("?Ln" . ?q) ; landscape mode
X    ("?Pn" . ?p) ; portrait mode
X))))
X
X(defun enable-arrow-keys ()
X  "Enable the use of the Twist arrow keys for cursor motion.
XBecause of the nature of the Twist, this unavoidably breaks
Xthe standard Emacs command ESC [; therefore, it is not done by default,
Xbut only if you give this command."
X  (interactive)
X  (global-set-key "\e[" CSI-map)
X  (send-string-to-terminal "\e[?1n") ; Landscape or portrait?
X)
X
X(defvar SS3a-map nil
X  "SS3a-map maps the SS3 function keys on the Twist keyboard.
XThe SS3 keys are the numeric keypad keys in keypad application mode
X\(DECKPAM).  SS3 is DEC's name for the sequence <ESC>O which is
Xthe common prefix of what these keys transmit.")
X
X(if (not SS3a-map)
X    (progn
X     (setq SS3a-map (lookup-key global-map "\eO"))
X     (if (not (keymapp SS3a-map))
X     (setq SS3a-map (make-keymap)))  ;; <ESC>O commands
X     (setup-terminal-keymap SS3a-map
X        '(("A" . ?u)       ; up arrow
X          ("B" . ?d)       ; down-arrow
X          ("C" . ?r)       ; right-arrow
X          ("D" . ?l)       ; left-arrow
X          ("M" . ?e)       ; Enter
X          ("P" . ?\C-a)       ; PF1
X          ("Q" . ?\C-b)       ; PF2
X          ("R" . ?\C-c)       ; PF3
X          ("S" . ?\C-d)       ; PF4
X          ("l" . ?,)       ; ,
X          ("m" . ?-)       ; -
X          ("n" . ?.)       ; .
X          ("p" . ?0)       ; 0
X          ("q" . ?1)       ; 1
X          ("r" . ?2)       ; 2
X          ("s" . ?3)       ; 3
X          ("t" . ?4)       ; 4
X          ("u" . ?5)       ; 5
X          ("v" . ?6)       ; 6
X          ("w" . ?7)       ; 7
X          ("x" . ?8)       ; 8
X          ("y" . ?9)))))       ; 9
X
X(defun keypad-application-mode ()
X  "Switch on keypad application mode."
X  (interactive)
X  (send-string-to-terminal "\e=")
X  (global-set-key "\eO" SS3a-map))
X
X(defvar SS3n-map nil
X  "SS3n-map maps the SS3 function keys on the Twist keyboard.
XThe SS3 keys are the numeric keypad keys in keypad numeric mode
X\(DECKPAM).  SS3 is DEC's name for the sequence <ESC>O which is
Xthe common prefix of what these keys transmit.")
X
X(if (not SS3n-map)
X    (progn
X     (setq SS3n-map (lookup-key global-map "\eO"))
X     (if (not (keymapp SS3n-map))
X     (setq SS3n-map (make-sparse-keymap)))  ;; <ESC>O commands
X     (setup-terminal-keymap SS3n-map '(
X          ("P" . ?\C-a)       ; PF1
X          ("Q" . ?\C-b)       ; PF2
X          ("R" . ?\C-c)       ; PF3
X          ("S" . ?\C-d)       ; PF4
X     ))
X    (global-set-key "\eO" SS3n-map)
X))
X
X(if (fboundp 'get-glyf)
X   (progn
X      (require 'iso8859-1-swedish)
X      (require 'char-table-vt100)
X      (send-string-to-terminal "\e)B\e)1") ; Select Swedish letters as G1 set.
X      (standard-char-underline 170 ?a) ; ordinal indicator, feminine
X      (standard-char-graphic   176 125); degree sign
X      (standard-char-graphic   177 ?~) ; plus or minus sign
X      (standard-char-graphic   183 ?g) ; middle dot
X      (standard-char-underline 186 ?o) ; ordinal indicator, masculine
X      (standard-frameg-graphic ?x)     ; Vertical bar.
X      (standard-truncg-graphic ?t)     ; Left T.
X      (standard-wrapg-graphic  ?k)     ; Upper right corner.
X   )
X)
X
X(defun redraw-screen-24-lines ()
X   "This function is intended for use with Facit Twist terminals.
XIt should be bound to \"C-[[?Ln\", which is what the terminal transmits
Xwhen it is twisted into landscape mode.  The terminal must also have
Xthe Display Report switch (custom setup 4, group 1, switch 3) set to
XAuto."
X   (interactive)
X   (set-screen-height 24))
X
X(defun redraw-screen-72-lines ()
X   "This function is intended for use with Facit Twist terminals.
XIt should be bound to \"C-[[?Pn\", which is what the terminal transmits
Xwhen it is twisted into portrait mode.  The terminal must also have
Xthe Display Report switch (custom setup 4, group 1, switch 3) set to
XAuto."
X   (interactive)
X   (send-string-to-terminal "\e[r")
X   (set-screen-height 72))
X
X(setq start-emphasis "\e[4m") ; Underline on.
X(setq stop-emphasis  "\e[m")  ; Underline off.
END_OF_FILE
if test 4902 -ne `wc -c <'lisp/term/fa4440a.el'`; then
    echo shar: \"'lisp/term/fa4440a.el'\" unpacked with wrong size!
fi
# end of 'lisp/term/fa4440a.el'
fi
if test -f 'lisp/term/fa4440b.el' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lisp/term/fa4440b.el'\"
else
echo shar: Extracting \"'lisp/term/fa4440b.el'\" \(4902 characters\)
sed "s/^X//" >'lisp/term/fa4440b.el' <<'END_OF_FILE'
X;;; Set up Facit 4440 (Twist) terminal.
X
X;; Map Twist function key escape sequences
X;; into the standard slots in function-keymap.
X
X(require 'keypad)
X
X(keypad-default "p" 'redraw-screen-72-lines)
X(keypad-default "q" 'redraw-screen-24-lines)
X
X(defvar CSI-map nil
X  "The CSI-map maps the CSI function keys on the Twist keyboard.
XThe CSI keys are the arrow keys.")
X
X(if (not CSI-map)
X    (progn
X     (setq CSI-map (lookup-key global-map "\e["))
X     (if (not (keymapp CSI-map))
X     (setq CSI-map (make-sparse-keymap)))  ;; <ESC>[ commands
X     (setup-terminal-keymap CSI-map '(
X        ("A"   . ?u) ; up arrow
X    ("B"   . ?d) ; down-arrow
X    ("C"   . ?r) ; right-arrow
X    ("D"   . ?l) ; left-arrow
X    ("H"   . ?h) ; home
X    ("J"   . ?C) ; shift-erase = clear screen
X    ("K"   . ?c) ; erase
X    ("L"   . ?A) ; insert line
X    ("M"   . ?L) ; delete line
X    ("P"   . ?D) ; delete character
X    ("U"   . ?N) ; shift-down-arrow = next page
X    ("V"   . ?P) ; shift-up-arrow = previous page
X    ("X"   . ?H) ; shift-home = home-down
X    ("Z"   . ?b) ; tabulation backward
X    ("4h"  . ?I) ; insert character
X    ("?Ln" . ?q) ; landscape mode
X    ("?Pn" . ?p) ; portrait mode
X))))
X
X(defun enable-arrow-keys ()
X  "Enable the use of the Twist arrow keys for cursor motion.
XBecause of the nature of the Twist, this unavoidably breaks
Xthe standard Emacs command ESC [; therefore, it is not done by default,
Xbut only if you give this command."
X  (interactive)
X  (global-set-key "\e[" CSI-map)
X  (send-string-to-terminal "\e[?1n") ; Landscape or portrait?
X)
X
X(defvar SS3a-map nil
X  "SS3a-map maps the SS3 function keys on the Twist keyboard.
XThe SS3 keys are the numeric keypad keys in keypad application mode
X\(DECKPAM).  SS3 is DEC's name for the sequence <ESC>O which is
Xthe common prefix of what these keys transmit.")
X
X(if (not SS3a-map)
X    (progn
X     (setq SS3a-map (lookup-key global-map "\eO"))
X     (if (not (keymapp SS3a-map))
X     (setq SS3a-map (make-keymap)))  ;; <ESC>O commands
X     (setup-terminal-keymap SS3a-map
X        '(("A" . ?u)       ; up arrow
X          ("B" . ?d)       ; down-arrow
X          ("C" . ?r)       ; right-arrow
X          ("D" . ?l)       ; left-arrow
X          ("M" . ?e)       ; Enter
X          ("P" . ?\C-a)       ; PF1
X          ("Q" . ?\C-b)       ; PF2
X          ("R" . ?\C-c)       ; PF3
X          ("S" . ?\C-d)       ; PF4
X          ("l" . ?,)       ; ,
X          ("m" . ?-)       ; -
X          ("n" . ?.)       ; .
X          ("p" . ?0)       ; 0
X          ("q" . ?1)       ; 1
X          ("r" . ?2)       ; 2
X          ("s" . ?3)       ; 3
X          ("t" . ?4)       ; 4
X          ("u" . ?5)       ; 5
X          ("v" . ?6)       ; 6
X          ("w" . ?7)       ; 7
X          ("x" . ?8)       ; 8
X          ("y" . ?9)))))       ; 9
X
X(defun keypad-application-mode ()
X  "Switch on keypad application mode."
X  (interactive)
X  (send-string-to-terminal "\e=")
X  (global-set-key "\eO" SS3a-map))
X
X(defvar SS3n-map nil
X  "SS3n-map maps the SS3 function keys on the Twist keyboard.
XThe SS3 keys are the numeric keypad keys in keypad numeric mode
X\(DECKPAM).  SS3 is DEC's name for the sequence <ESC>O which is
Xthe common prefix of what these keys transmit.")
X
X(if (not SS3n-map)
X    (progn
X     (setq SS3n-map (lookup-key global-map "\eO"))
X     (if (not (keymapp SS3n-map))
X     (setq SS3n-map (make-sparse-keymap)))  ;; <ESC>O commands
X     (setup-terminal-keymap SS3n-map '(
X          ("P" . ?\C-a)       ; PF1
X          ("Q" . ?\C-b)       ; PF2
X          ("R" . ?\C-c)       ; PF3
X          ("S" . ?\C-d)       ; PF4
X     ))
X    (global-set-key "\eO" SS3n-map)
X))
X
X(if (fboundp 'get-glyf)
X   (progn
X      (require 'iso8859-1-swedish)
X      (require 'char-table-vt100)
X      (send-string-to-terminal "\e)B\e)1") ; Select Swedish letters as G1 set.
X      (standard-char-underline 170 ?a) ; ordinal indicator, feminine
X      (standard-char-graphic   176 125); degree sign
X      (standard-char-graphic   177 ?~) ; plus or minus sign
X      (standard-char-graphic   183 ?g) ; middle dot
X      (standard-char-underline 186 ?o) ; ordinal indicator, masculine
X      (standard-frameg-graphic ?x)     ; Vertical bar.
X      (standard-truncg-graphic ?t)     ; Left T.
X      (standard-wrapg-graphic  ?k)     ; Upper right corner.
X   )
X)
X
X(defun redraw-screen-24-lines ()
X   "This function is intended for use with Facit Twist terminals.
XIt should be bound to \"C-[[?Ln\", which is what the terminal transmits
Xwhen it is twisted into landscape mode.  The terminal must also have
Xthe Display Report switch (custom setup 4, group 1, switch 3) set to
XAuto."
X   (interactive)
X   (set-screen-height 24))
X
X(defun redraw-screen-72-lines ()
X   "This function is intended for use with Facit Twist terminals.
XIt should be bound to \"C-[[?Pn\", which is what the terminal transmits
Xwhen it is twisted into portrait mode.  The terminal must also have
Xthe Display Report switch (custom setup 4, group 1, switch 3) set to
XAuto."
X   (interactive)
X   (send-string-to-terminal "\e[r")
X   (set-screen-height 72))
X
X(setq start-emphasis "\e[4m") ; Underline on.
X(setq stop-emphasis  "\e[m")  ; Underline off.
END_OF_FILE
if test 4902 -ne `wc -c <'lisp/term/fa4440b.el'`; then
    echo shar: \"'lisp/term/fa4440b.el'\" unpacked with wrong size!
fi
# end of 'lisp/term/fa4440b.el'
fi
if test -f 'src/casetab.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'src/casetab.c'\"
else
echo shar: Extracting \"'src/casetab.c'\" \(5975 characters\)
sed "s/^X//" >'src/casetab.c' <<'END_OF_FILE'
X/* GNU Emacs routines to deal with case tables.
X   Copyright (C) 1987 Free Software Foundation, Inc.
X
XThis file is part of GNU Emacs.
X
XGNU Emacs is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY.  No author or distributor
Xaccepts responsibility to anyone for the consequences of using it
Xor for whether it serves any particular purpose or works at all,
Xunless he says so in writing.  Refer to the GNU Emacs General Public
XLicense for full details.
X
XEveryone is granted permission to copy, modify and redistribute
XGNU Emacs, but only under the conditions described in the
XGNU Emacs General Public License.   A copy of this license is
Xsupposed to have been given to you along with GNU Emacs so you
Xcan know your rights and responsibilities.  It should be in a
Xfile named COPYING.  Among other things, the copyright notice
Xand this notice must be preserved on all copies.  */
X
X/* Written by Howard Gayle.  See chartab.c for details. */
X
X#include "config.h"
X#include "lisp.h"
X#include "buffer.h"
X#include "casetab.h"
X#include "etctab.h"
X
XLisp_Object Qcase_table_p;
XDEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,
X   "Return t iff ARG is a case table.")
X(obj)
XLisp_Object obj;
X{
Xreturn ((XTYPE (obj) == Lisp_Casetab) ? Qt : Qnil);
X}
X
Xstatic Lisp_Object
Xcheck_case_table (obj)
XLisp_Object obj;
X{
Xregister Lisp_Object tem;
X
Xwhile (tem = Fcase_table_p (obj), NULL (tem))
X   obj = wrong_type_argument (Qcase_table_p, obj, 0);
Xreturn (obj);
X}
X
X/* Convert the given Lisp_Casetab to a Lisp_Object. */
Xstatic Lisp_Object
Xenlisp_case_table (sp)
Xstruct Lisp_Casetab *sp;
X{
Xregister Lisp_Object z; /* Return. */
X
XXSET (z, Lisp_Casetab, sp);
Xreturn (z);
X}
X
XDEFUN ("case-table", Fcase_table, Scase_table, 0, 0, 0,
X   "Return the case table of the current buffer.")
X()
X{
Xreturn (enlisp_case_table (bf_cur->case_table_v));
X}
X
XDEFUN ("standard-case-table", Fstandard_case_table,
X   Sstandard_case_table, 0, 0, 0,
X   "Return the standard case table.\n\
XThis is the one used for new buffers.")
X()
X{
Xreturn (enlisp_case_table (buffer_defaults.case_table_v));
X}
X
X/* Extract the case table from the given Lisp object.  Check for errors. */
Xstatic struct Lisp_Casetab *
Xget_case_table_arg (obj)
Xregister Lisp_Object obj;
X{
Xif (NULL (obj)) return (bf_cur->case_table_v);
Xobj = check_case_table (obj);
Xreturn (XCASETAB (obj));
X}
X
X/* Store a case table.  Check for errors. */
Xstatic Lisp_Object
Xset_case_table (p, t)
Xstruct Lisp_Casetab **p; /* Points to where to store the case table. */
Xregister Lisp_Object  t; /* The case table as a Lisp object. */
X{
Xt = check_case_table (t);
X*p = XCASETAB (t);
Xreturn (t);
X}
X
XDEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
X   "Select a new case table for the current buffer.\n\
XOne argument, a case table.")
X(table)
XLisp_Object table;
X{
Xreturn (set_case_table (&bf_cur->case_table_v, table));
X}
X
XDEFUN ("set-standard-case-table",
X   Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0,
X   "Select a new standard case table.  This does not change the\n\
Xcase tables of any existing buffers.  One argument, a case table.")
X(table)
XLisp_Object table;
X{
Xreturn (set_case_table (&buffer_defaults.case_table_v, table));
X}
X
XDEFUN ("make-case-table", Fmake_case_table, Smake_case_table, 0, 0, 0,
X   "Make a new case table.  All characters are caseless.")
X()
X{
Xregister struct Lisp_Casetab *nt; /* New case table. */
Xregister int                      i;
Xregister Lisp_Object           z;  /* Return. */
X
Xz = make_etc_table (sizeof (struct Lisp_Casetab), Lisp_Casetab);
Xnt = XCASETAB (z);
Xfor (i = 0; i <= 255; ++i)
X   nt->cas_case[i] = nocase_e;
Xreturn (z);
X}
X
XDEFUN ("nocase-p", Fnocase_p, Snocase_p, 1, 2, 0,
X   "Return t iff character CHAR is caseless, according to case\n\
Xtable TABLE.")
X(ch, table)
XLisp_Object ch;
XLisp_Object table;
X{
Xreturn (CASETAB_ISNOCASE (get_char_arg (ch), get_case_table_arg (table))
X        ? Qt : Qnil);
X}
X
XDEFUN ("lower-p", Flower_p, Slower_p, 1, 2, 0,
X   "Return t iff character CHAR is lower case, according to case\n\
Xtable TABLE (default (case-table)).")
X(ch, table)
XLisp_Object ch;
XLisp_Object table;
X{
Xreturn (CASETAB_ISLOWER (get_char_arg (ch), get_case_table_arg (table))
X        ? Qt : Qnil);
X}
X
XDEFUN ("upper-p", Fupper_p, Supper_p, 1, 2, 0,
X   "Return t iff character CHAR is upper case, according to case\n\
Xtable TABLE (default (case-table)).")
X(ch, table)
XLisp_Object ch;
XLisp_Object table;
X{
Xreturn (CASETAB_ISUPPER (get_char_arg (ch), get_case_table_arg (table))
X        ? Qt : Qnil);
X}
X
XDEFUN ("set-case-table-nocase",
X   Fset_case_table_nocase, Sset_case_table_nocase, 1, 2, 0,
X   "Mark character CHAR as caseless in case table TABLE\n\
X(default (case-table)).")
X(ch, table)
XLisp_Object ch;
XLisp_Object table;
X{
Xget_case_table_arg (table)->cas_case[get_char_arg (ch)] = nocase_e;
Xreturn (ch);
X}
X
XDEFUN ("set-case-table-pair",
X   Fset_case_table_pair, Sset_case_table_pair, 2, 3, 0,
X   "Mark characters LC and UC as an (upper case, lower case)\n\
Xpair in case table TABLE (default (case-table)).")
X(lc, uc, table)
XLisp_Object lc;
XLisp_Object uc;
XLisp_Object table;
X{
Xregister struct Lisp_Casetab *cp = get_case_table_arg (table);
Xregister char_t lch = get_char_arg (lc);
Xregister char_t uch = get_char_arg (uc);
X
Xcp->cas_case[lch] = lowercase_e;
Xcp->cas_case[uch] = uppercase_e;
Xreturn (lc);
X}
X
Xinit_case_table_once ()
X{
Xregister int i;
Xregister case_t *p;
X
XFset_standard_case_table (Fmake_case_table ());
Xp = buffer_defaults.case_table_v->cas_case;
Xfor (i = 'A'; i <= 'Z'; ++i)
X   p[i] = uppercase_e;
Xfor (i = 'a'; i <= 'z'; ++i)
X   p[i] = lowercase_e;
X}
X
Xsyms_of_case_table ()
X{
XQcase_table_p = intern ("case-table-p");
Xstaticpro (&Qcase_table_p);
X
Xdefsubr (&Scase_table_p);
Xdefsubr (&Scase_table);
Xdefsubr (&Sstandard_case_table);
Xdefsubr (&Sset_case_table);
Xdefsubr (&Sset_standard_case_table);
Xdefsubr (&Smake_case_table);
Xdefsubr (&Snocase_p);
Xdefsubr (&Slower_p);
Xdefsubr (&Supper_p);
Xdefsubr (&Sset_case_table_nocase);
Xdefsubr (&Sset_case_table_pair);
X}
END_OF_FILE
if test 5975 -ne `wc -c <'src/casetab.c'`; then
    echo shar: \"'src/casetab.c'\" unpacked with wrong size!
fi
# end of 'src/casetab.c'
fi
if test -f 'src/etctab.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'src/etctab.h'\"
else
echo shar: Extracting \"'src/etctab.h'\" \(1064 characters\)
sed "s/^X//" >'src/etctab.h' <<'END_OF_FILE'
X/* Declarations for miscellaneous Lisp table objects.
X   Copyright (C) 1987 Free Software Foundation, Inc.
X
XThis file is part of GNU Emacs.
X
XGNU Emacs is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY.  No author or distributor
Xaccepts responsibility to anyone for the consequences of using it
Xor for whether it serves any particular purpose or works at all,
Xunless he says so in writing.  Refer to the GNU Emacs General Public
XLicense for full details.
X
XEveryone is granted permission to copy, modify and redistribute
XGNU Emacs, but only under the conditions described in the
XGNU Emacs General Public License.   A copy of this license is
Xsupposed to have been given to you along with GNU Emacs so you
Xcan know your rights and responsibilities.  It should be in a
Xfile named COPYING.  Among other things, the copyright notice
Xand this notice must be preserved on all copies.  */
X
X/* Written by Howard Gayle.  See chartab.c for details. */
X
Xextern struct Lisp_Etctab *all_etc_tables;
XLisp_Object make_etc_table ();
Xchar_t get_char_arg ();
END_OF_FILE
if test 1064 -ne `wc -c <'src/etctab.h'`; then
    echo shar: \"'src/etctab.h'\" unpacked with wrong size!
fi
# end of 'src/etctab.h'
fi
echo shar: End of archive 3 \(of 4\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 4 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0