Mercurial > hg > xemacs-beta

comparison lisp/prim/disp-table.el @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
2 2
3 ;; Copyright (C) 1987, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1987, 1994 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Sun Microsystems. 4 ;; Copyright (C) 1995 Sun Microsystems.
5 5
6 ;; Author: Howard Gayle 6 ;; Author: Howard Gayle
7 ;; Maintainer: FSF 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: i18n 8 ;; Keywords: i18n
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
11 11
12 ;; XEmacs is free software; you can redistribute it and/or modify it 12 ;; XEmacs is free software; you can redistribute it and/or modify it
33 ;;; #### display-tables-as-vectors is really evil and a big pain in 33 ;;; #### display-tables-as-vectors is really evil and a big pain in
34 ;;; the ass. 34 ;;; the ass.
35 35
36 ;;; Rewritten for XEmacs July 1995, Ben Wing. 36 ;;; Rewritten for XEmacs July 1995, Ben Wing.
37 37
38
38 ;;; Code: 39 ;;; Code:
39 40
40 (defun describe-display-table (dt) 41 (defun describe-display-table (dt)
41 "Describe the display table DT in a help buffer." 42 "Describe the display table DT in a help buffer."
42 (with-displaying-help-buffer 43 (with-displaying-help-buffer
43 (lambda () 44 (lambda ()
44 (princ "\nCharacter display glyph sequences:\n") 45 (princ "\nCharacter display glyph sequences:\n")
45 (save-excursion 46 (save-excursion
46 (set-buffer standard-output)
47 (let ((vector (make-vector 256 nil)) 47 (let ((vector (make-vector 256 nil))
48 (i 0)) 48 (i 0))
49 (while (< i 256) 49 (while (< i 256)
50 (aset vector i (aref dt i)) 50 (aset vector i (aref dt i))
51 (setq i (1+ i))) 51 (incf i))
52 ;;; ### No such function `describe-vector'... 52 ;; FSF calls `describe-vector' here, but it is so incredibly
53 (describe-vector vector)))))) 53 ;; lame a function for that name that I cannot bring myself
54 ;; to porting it. Here is what `describe-vector' does:
55 (terpri)
56 (let ((old (aref vector 0))
57 (oldpos 0)
58 (i 1)
59 str)
60 (while (<= i 256)
61 (when (or (= i 256)
62 (not (equal old (aref vector i))))
63 (if (eq oldpos (1- i))
64 (princ (format "%s\t\t%s\n"
65 (single-key-description (int-char oldpos))
66 old))
67 (setq str (format "%s - %s"
68 (single-key-description (int-char oldpos))
69 (single-key-description (int-char (1- i)))))
70 (princ str)
71 (princ (make-string (max (- 2 (/ (length str)
72 tab-width)) 1) ?\t))
73 (princ old)
74 (terpri))
75 (or (= i 256)
76 (setq old (aref vector i)
77 oldpos i)))
78 (incf i))))))))
54 79
55 ;;;###autoload 80 ;;;###autoload
56 (defun describe-current-display-table (&optional domain) 81 (defun describe-current-display-table (&optional domain)
57 "Describe the display table in use in the selected window and buffer." 82 "Describe the display table in use in the selected window and buffer."
58 (interactive) 83 (interactive)