From: Michal Nazarewicz Date: Wed, 3 Dec 2014 18:49:42 +0000 (+0100) Subject: descr-text: add `describe-char-eldoc' describing character at point X-Git-Tag: emacs-25.0.90~2592^2~6 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=81681ed9a1e609101377d674613832008a667587;p=emacs.git 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'. --- diff --git a/etc/NEWS b/etc/NEWS index 7944b000f7b..3e8ed40f2a7 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 d3bfafdf721..ab338f8ed88 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2015-01-20 Michal Nazarewicz + + * 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 * textmodes/paragraphs.el (sentence-end-base): Include an diff --git a/lisp/descr-text.el b/lisp/descr-text.el index b16c007e5b9..d6f64c77e61 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 544835bdd4f..09eb63d46bb 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,9 @@ +2015-01-20 Michal Nazarewicz + + * 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 * automated/tildify-tests.el (tildify-space-undo-test--test): diff --git a/test/automated/descr-text-test.el b/test/automated/descr-text-test.el new file mode 100644 index 00000000000..81ae727f076 --- /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 + +;; 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 . + +;;; 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