[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 81681ed 1/2: descr-text: add `describe-char-eldoc'
From: |
Michal Nazarewicz |
Subject: |
[Emacs-diffs] master 81681ed 1/2: descr-text: add `describe-char-eldoc' describing character at point |
Date: |
Tue, 20 Jan 2015 14:06:29 +0000 |
branch: master
commit 81681ed9a1e609101377d674613832008a667587
Author: Michal Nazarewicz <address@hidden>
Commit: Michal Nazarewicz <address@hidden>
descr-text: add `describe-char-eldoc' describing character at point
* lisp/descr-text.el (describe-char-eldoc): New function returning
basic Unicode codepoint information (e.g. name) about character
at point. It is meant to be used as a default value of the
`eldoc-documentation-function' variable.
(describe-char-eldoc--format, describe-char-eldoc--truncate):
New helper functions for `describe-char-eldoc' function.
* tests/automated/descr-text-test.el: New file with tests for
`describe-char-eldoc--truncate', `describe-char-eldoc--format',
and `describe-char-eldoc'.
---
etc/NEWS | 8 ++-
lisp/ChangeLog | 9 ++++
lisp/descr-text.el | 96 +++++++++++++++++++++++++++++++++++++
test/ChangeLog | 6 ++
test/automated/descr-text-test.el | 94 ++++++++++++++++++++++++++++++++++++
5 files changed, 211 insertions(+), 2 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7944b00..3e8ed40 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -238,8 +238,12 @@ typing RET.
result of the calculation into the current buffer.
** ElDoc
-*** New minor mode global-eldoc-mode
-*** eldoc-documentation-function now defaults to nil
+*** New minor mode `global-eldoc-mode'
+*** `eldoc-documentation-function' now defaults to `ignore'
+*** `describe-char-eldoc' displays information about character at point,
+and can be used as a default value of `eldoc-documentation-function'. It is
+useful when, for example, one needs to distinguish various spaces (e.g. ] [,
+] [, ] [, etc.) while using mono-spaced font.
** eww
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d3bfafd..ab338f8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,14 @@
2015-01-20 Michal Nazarewicz <address@hidden>
+ * descr-text.el (describe-char-eldoc): New function returning
+ basic Unicode codepoint information (e.g. name) about character
+ at point. It is meant to be used as a default value of the
+ `eldoc-documentation-function' variable.
+ (describe-char-eldoc--format, describe-char-eldoc--truncate):
+ New helper functions for `describe-char-eldoc' function.
+
+2015-01-20 Michal Nazarewicz <address@hidden>
+
* textmodes/paragraphs.el (sentence-end-base): Include an
ellipsis (…) and interrobang (‽) characters as end of a sentence,
and a closing single quote (’) as an end of a quote.
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index b16c007..d6f64c7 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -825,6 +825,102 @@ relevant to POS."
(define-obsolete-function-alias 'describe-char-after 'describe-char "22.1")
+;;; Describe-Char-ElDoc
+
+(defun describe-char-eldoc--truncate (name width)
+ "Truncate NAME at white spaces such that it is no longer than WIDTH.
+
+Split NAME on white space character and return string with as
+many leading words of NAME as possible without exceeding WIDTH
+characters. If NAME consists of white space characters only,
+return an empty string. Three dots (\"...\") are appended to
+returned string if some of the words from NAME have been omitted.
+
+NB: Function may return string longer than WIDTH if name consists
+of a single word, or it's first word is longer than WIDTH
+characters."
+ (let ((words (split-string name)))
+ (if words
+ (let ((last words))
+ (setq width (- width (length (car words))))
+ (while (and (cdr last)
+ (<= (+ (length (cadr last)) (if (cddr last) 4 1)) width))
+ (setq last (cdr last))
+ (setq width (- width (length (car last)) 1)))
+ (let ((ellipsis (and (cdr last) "...")))
+ (setcdr last nil)
+ (concat (mapconcat 'identity words " ") ellipsis)))
+ "")))
+
+(defun describe-char-eldoc--format (ch &optional width)
+ "Format a description for character CH which is no more than WIDTH
characters.
+
+Full description message has a \"U+HEX: NAME (GC: GENERAL-CATEGORY)\"
+format where:
+- HEX is a hexadecimal codepoint of the character (zero-padded to at
+ least four digits),
+- NAME is name of the character.
+- GC is a two-letter abbreviation of the general-category of the
+ character, and
+- GENERAL-CATEGORY is full name of the general-category of the
+ character.
+
+If WIDTH is non-nil some elements of the description may be
+omitted to accommodate the length restriction. Under certain
+condition, the function may return string longer than WIDTH, see
+`describe-char-eldoc--truncate'."
+ (let ((name (get-char-code-property ch 'name)))
+ (when name
+ (let* ((code (propertize (format "U+%04X" ch)
+ 'face 'font-lock-constant-face))
+ (gc (get-char-code-property ch 'general-category))
+ (gc-desc (char-code-property-description 'general-category gc)))
+
+ (unless (or (not width) (<= (length name) width))
+ (setq name (describe-char-eldoc--truncate name width)))
+ (setq name (concat (substring name 0 1) (downcase (substring name 1))))
+ (setq name (propertize name 'face 'font-lock-variable-name-face))
+
+ (setq gc (propertize (symbol-name gc) 'face 'font-lock-comment-face))
+ (when gc-desc
+ (setq gc-desc (propertize gc-desc 'face 'font-lock-comment-face)))
+
+ (let ((lcode (length code))
+ (lname (length name))
+ (lgc (length gc))
+ (lgc-desc (and gc-desc (length gc-desc))))
+ (cond
+ ((and gc-desc
+ (or (not width) (<= (+ lcode lname lgc lgc-desc 7) width)))
+ (concat code ": " name " (" gc ": " gc-desc ")"))
+ ((and gc-desc (<= (+ lcode lname lgc-desc 5) width))
+ (concat code ": " name " (" gc-desc ")"))
+ ((or (not width) (<= (+ lcode lname lgc 5) width))
+ (concat code ": " name " (" gc ")"))
+ ((<= (+ lname lgc 3) width)
+ (concat name " (" gc ")"))
+ (t name)))))))
+
+;;;###autoload
+(defun describe-char-eldoc ()
+ "Return a description of character at point for use by ElDoc mode.
+
+Return nil if character at point is a printable ASCII
+character (i.e. codepoint between 32 and 127 inclusively).
+Otherwise return a description formatted by
+`describe-char-eldoc--format' function taking into account value
+of `eldoc-echo-area-use-multiline-p' variable and width of
+minibuffer window for width limit.
+
+This function is meant to be used as a value of
+`eldoc-documentation-function' variable."
+ (let ((ch (following-char)))
+ (when (and (not (zerop ch)) (or (< ch 32) (> ch 127)))
+ (describe-char-eldoc--format
+ ch
+ (unless (eq eldoc-echo-area-use-multiline-p t)
+ (1- (window-width (minibuffer-window))))))))
+
(provide 'descr-text)
;;; descr-text.el ends here
diff --git a/test/ChangeLog b/test/ChangeLog
index 544835b..09eb63d 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,11 @@
2015-01-20 Michal Nazarewicz <address@hidden>
+ * automated/descr-text-test.el: New file with tests for
+ `describe-char-eldoc--truncate', `describe-char-eldoc--format',
+ and `describe-char-eldoc'.
+
+2015-01-20 Michal Nazarewicz <address@hidden>
+
* automated/tildify-tests.el (tildify-space-undo-test--test):
A new helper function for testing `tildify-double-space-undos'
behaviour in the `tildify-space' function.
diff --git a/test/automated/descr-text-test.el
b/test/automated/descr-text-test.el
new file mode 100644
index 0000000..81ae727
--- /dev/null
+++ b/test/automated/descr-text-test.el
@@ -0,0 +1,94 @@
+;;; descr-text-test.el --- ERT tests for descr-text.el -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Michal Nazarewicz <address@hidden>
+
+;; 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 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package defines regression tests for the descr-text package.
+
+;;; Code:
+
+(require 'ert)
+(require 'descr-text)
+
+
+(ert-deftest descr-text-test-truncate ()
+ "Tests describe-char-eldoc--truncate function."
+ (should (equal ""
+ (describe-char-eldoc--truncate " \t \n" 100)))
+ (should (equal "foo"
+ (describe-char-eldoc--truncate "foo" 1)))
+ (should (equal "foo..."
+ (describe-char-eldoc--truncate "foo wilma fred" 0)))
+ (should (equal "foo..."
+ (describe-char-eldoc--truncate
+ "foo wilma fred" (length "foo wilma"))))
+ (should (equal "foo wilma..."
+ (describe-char-eldoc--truncate
+ "foo wilma fred" (+ 3 (length "foo wilma")))))
+ (should (equal "foo wilma..."
+ (describe-char-eldoc--truncate
+ "foo wilma fred" (1- (length "foo wilma fred")))))
+ (should (equal "foo wilma fred"
+ (describe-char-eldoc--truncate
+ "foo wilma fred" (length "foo wilma fred"))))
+ (should (equal "foo wilma fred"
+ (describe-char-eldoc--truncate
+ " foo\t wilma \nfred\t " (length "foo wilma fred")))))
+
+(ert-deftest descr-text-test-format-desc ()
+ "Tests describe-char-eldoc--format function."
+ (should (equal "U+2026: Horizontal ellipsis (Po: Punctuation, Other)"
+ (describe-char-eldoc--format ?…)))
+ (should (equal "U+2026: Horizontal ellipsis (Punctuation, Other)"
+ (describe-char-eldoc--format ?… 51)))
+ (should (equal "U+2026: Horizontal ellipsis (Po)"
+ (describe-char-eldoc--format ?… 40)))
+ (should (equal "Horizontal ellipsis (Po)"
+ (describe-char-eldoc--format ?… 30)))
+ (should (equal "Horizontal ellipsis"
+ (describe-char-eldoc--format ?… 20)))
+ (should (equal "Horizontal..."
+ (describe-char-eldoc--format ?… 10))))
+
+(ert-deftest descr-text-test-desc ()
+ "Tests describe-char-eldoc function."
+ (with-temp-buffer
+ (insert "a…")
+ (goto-char (point-min))
+ (should (eq ?a (following-char))) ; make sure we are where we think we are
+ ;; Function should return nil for an ASCII character.
+ (should (not (describe-char-eldoc)))
+
+ (goto-char (1+ (point)))
+ (should (eq ?… (following-char)))
+ (let ((eldoc-echo-area-use-multiline-p t))
+ ;; Function should return description of an Unicode character.
+ (should (equal "U+2026: Horizontal ellipsis (Po: Punctuation, Other)"
+ (describe-char-eldoc))))
+
+ (goto-char (point-max))
+ ;; At the end of the buffer, function should return nil and not blow up.
+ (should (not (describe-char-eldoc)))))
+
+
+(provide 'descr-text-test)
+
+;;; descr-text-test.el ends here