X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c0274f385fe5f39459cac5ea9ff9f92bacd3a8ef..4be9beaf4e4120f67dbf525a84789525bfef2ef8:/lisp/case-table.el diff --git a/lisp/case-table.el b/lisp/case-table.el index bb35c1e891..79cc96b5b3 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el @@ -1,12 +1,16 @@ -;;; case-table.el --- functions for extending the character set and dealing with case tables. +;;; case-table.el --- code to extend the character set and support case tables. -;; Copyright (C) 1988 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. + +;; Author: Howard Gayle +;; Maintainer: FSF +;; Keywords: i18n ;; This file is part of GNU Emacs. ;; GNU Emacs 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 1, or (at your option) +;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -15,9 +19,11 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;;; Commentary: ;; Written by: ;; TN/ETX/TX/UMG Howard Gayle UUCP : seismo!enea!erix!howard @@ -26,77 +32,99 @@ ;; S-126 25 Stockholm FAX : +46 8 719 64 82 ;; Sweden +;;; Code: + +(defvar set-case-syntax-offset 0) + +(defvar set-case-syntax-set-multibyte nil) + (defun describe-buffer-case-table () "Describe the case table of the current buffer." (interactive) - (let ((vector (make-vector 256 nil)) - (case-table (current-case-table)) - (i 0)) - (while (< i 256) - (aset vector i - (cond ((/= ch (downcase ch)) - (concat "uppercase, matches " - (text-char-description (downcase ch)))) - ((/= ch (upcase ch)) - (concat "lowercase, matches " - (text-char-description (upcase ch)))) - (t "case-invariant"))) - (setq i (1+ i)))) - (with-output-to-temp-buffer "*Help*" - (describe-vector vector))) - -(defun invert-case (count) - "Change the case of the character just after point and move over it. -With prefix arg, applies to that many chars. -Negative arg inverts characters before point but does not move." - (interactive "p") - (if (< count 0) - (progn (setq count (min (1- (point)) (- count))) - (forward-char (- count)))) - (while (> count 0) - (let ((oc (following-char))) ; Old character. - (cond ((/= (upcase ch) ch) - (replace-char (upcase ch))) - ((/= (downcase ch) ch) - (replace-char (downcase ch))))) - (forward-char 1) - (setq count (1- count)))) + (let ((description (make-char-table 'case-table))) + (map-char-table + (function (lambda (key value) + (aset + description key + (cond ((not (natnump value)) + "case-invariant") + ((/= key (downcase key)) + (concat "uppercase, matches " + (char-to-string (downcase key)))) + ((/= key (upcase key)) + (concat "lowercase, matches " + (char-to-string (upcase key)))) + (t "case-invariant"))))) + (current-case-table)) + (save-excursion + (with-output-to-temp-buffer "*Help*" + (set-buffer standard-output) + (describe-vector description) + (help-mode))))) + +(defun copy-case-table (case-table) + (let ((copy (copy-sequence case-table))) + ;; Clear out the extra slots so that they will be + ;; recomputed from the main (downcase) table. + (set-char-table-extra-slot copy 0 nil) + (set-char-table-extra-slot copy 1 nil) + (set-char-table-extra-slot copy 2 nil) + copy)) + +(defsubst set-case-syntax-1 (char) + "Offset CHAR by `set-case-syntax-offset' if CHAR is a non-ASCII 8-bit char." + (if (and (>= char 128) (< char 256)) + (+ char set-case-syntax-offset) + char)) (defun set-case-syntax-delims (l r table) "Make characters L and R a matching pair of non-case-converting delimiters. -Sets the entries for L and R in `standard-case-table', `standard-syntax-table', -and `text-mode-syntax-table' to indicate left and right delimiters." - (aset (car table) l l) - (aset (car table) r r) +This sets the entries for L and R in TABLE, which is a string +that will be used as the downcase part of a case table. +It also modifies `standard-syntax-table' to +indicate left and right delimiters." + (setq l (set-case-syntax-1 l)) + (setq r (set-case-syntax-1 r)) + (aset table l l) + (aset table r r) + ;; Clear out the extra slots so that they will be + ;; recomputed from the main (downcase) table. + (set-char-table-extra-slot table 0 nil) + (set-char-table-extra-slot table 1 nil) + (set-char-table-extra-slot table 2 nil) (modify-syntax-entry l (concat "(" (char-to-string r) " ") (standard-syntax-table)) - (modify-syntax-entry l (concat "(" (char-to-string r) " ") - text-mode-syntax-table) (modify-syntax-entry r (concat ")" (char-to-string l) " ") - (standard-syntax-table)) - (modify-syntax-entry r (concat ")" (char-to-string l) " ") - text-mode-syntax-table)) + (standard-syntax-table))) (defun set-case-syntax-pair (uc lc table) "Make characters UC and LC a pair of inter-case-converting letters. -Sets the entries for characters UC and LC in `standard-case-table', -`standard-syntax-table' and `text-mode-syntax-table' to indicate an -(uppercase, lowercase) pair of letters." - - (aset (car table) uc lc) +This sets the entries for characters UC and LC in TABLE, which is a string +that will be used as the downcase part of a case table. +It also modifies `standard-syntax-table' to give them the syntax of +word constituents." + (setq uc (set-case-syntax-1 uc)) + (setq lc (set-case-syntax-1 lc)) + (aset table uc lc) + (aset table lc lc) + (set-char-table-extra-slot table 0 nil) + (set-char-table-extra-slot table 1 nil) + (set-char-table-extra-slot table 2 nil) (modify-syntax-entry lc "w " (standard-syntax-table)) - (modify-syntax-entry lc "w " text-mode-syntax-table) - (modify-syntax-entry uc "w " (standard-syntax-table)) - (modify-syntax-entry uc "w " text-mode-syntax-table)) + (modify-syntax-entry uc "w " (standard-syntax-table))) (defun set-case-syntax (c syntax table) - "Make characters C case-invariant with syntax SYNTAX. -Sets the entries for character C in `standard-case-table', -`standard-syntax-table' and `text-mode-syntax-table' to indicate this. + "Make character C case-invariant with syntax SYNTAX. +This sets the entry for character C in TABLE, which is a string +that will be used as the downcase part of a case table. +It also modifies `standard-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"." - (aset (car table) c c) - (modify-syntax-entry c syntax (standard-syntax-table)) - (modify-syntax-entry c syntax text-mode-syntax-table)) + (setq c (set-case-syntax-1 c)) + (aset table c c) + (set-char-table-extra-slot table 0 nil) + (set-char-table-extra-slot table 1 nil) + (set-char-table-extra-slot table 2 nil) + (modify-syntax-entry c syntax (standard-syntax-table))) (provide 'case-table)