diff options
| author | Kenichi Handa | 2009-07-17 12:27:15 +0000 |
|---|---|---|
| committer | Kenichi Handa | 2009-07-17 12:27:15 +0000 |
| commit | db170c743ed325cbd0ed5c3ab93a1c07a0ec504f (patch) | |
| tree | e92bfef5d32d0f9bd5e5b134f668f4783d0f84d8 | |
| parent | 1fc87f9bebfe9ed4c10bd399f13e6901a6d73954 (diff) | |
| download | emacs-db170c743ed325cbd0ed5c3ab93a1c07a0ec504f.tar.gz emacs-db170c743ed325cbd0ed5c3ab93a1c07a0ec504f.zip | |
(describe-buffer-case-table): Fix for the case that KEY is a cons.
| -rw-r--r-- | lisp/case-table.el | 32 |
1 files changed, 19 insertions, 13 deletions
diff --git a/lisp/case-table.el b/lisp/case-table.el index 34e4fc7824c..32df0c2ab32 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el | |||
| @@ -39,19 +39,25 @@ | |||
| 39 | (let ((description (make-char-table 'case-table))) | 39 | (let ((description (make-char-table 'case-table))) |
| 40 | (map-char-table | 40 | (map-char-table |
| 41 | (function (lambda (key value) | 41 | (function (lambda (key value) |
| 42 | (if (consp key) | 42 | (if (not (natnump value)) |
| 43 | (set-char-table-range description key "case-invariant") | 43 | (if (consp key) |
| 44 | (aset | 44 | (set-char-table-range description key "case-invariant") |
| 45 | description key | 45 | (aset description key "case-invariant")) |
| 46 | (cond ((not (natnump value)) | 46 | (let (from to) |
| 47 | "case-invariant") | 47 | (if (consp key) |
| 48 | ((/= key (downcase key)) | 48 | (setq from (car key) to (cdr key)) |
| 49 | (concat "uppercase, matches " | 49 | (setq from (setq to key))) |
| 50 | (char-to-string (downcase key)))) | 50 | (while (<= from to) |
| 51 | ((/= key (upcase key)) | 51 | (aset |
| 52 | (concat "lowercase, matches " | 52 | description from |
| 53 | (char-to-string (upcase key)))) | 53 | (cond ((/= from (downcase from)) |
| 54 | (t "case-invariant")))))) | 54 | (concat "uppercase, matches " |
| 55 | (char-to-string (downcase from)))) | ||
| 56 | ((/= from (upcase from)) | ||
| 57 | (concat "lowercase, matches " | ||
| 58 | (char-to-string (upcase from)))) | ||
| 59 | (t "case-invariant"))) | ||
| 60 | (setq from (1+ from))))))) | ||
| 55 | (current-case-table)) | 61 | (current-case-table)) |
| 56 | (save-excursion | 62 | (save-excursion |
| 57 | (with-output-to-temp-buffer "*Help*" | 63 | (with-output-to-temp-buffer "*Help*" |