show-me-all-used-faces

show-me-used-faces.el

;; Description: Emacs functions to display a list of all faces currently used in open buffers
;; Author: Jordon Biondo
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; This program 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, or
;; (at your option) any later version.
;; 
;; This program 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 this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Code:
(require 'cl-lib)

(defun hash-keys (hash)
  "Returns the keys of HASH as a list."
  (let ((keys))
    (maphash (lambda (key _) (push key keys)) hash)
    keys))


(defun buffer-faces (&optional buffer defined-only)
  "Returns a list of all faces used in BUFFER.
If BUFFER is nil, the current buffer is used.
If defined-only is non nil, only symbol representations of faces are included."
  (interactive "b")  
  (let ((buffer (or buffer (current-buffer))))
    (with-current-buffer buffer
      (let ((faces (make-hash-table :test 'equal))
            (pos (point-min)))
        (while (setq pos (next-single-property-change pos 'face))
          (let ((face (plist-get (text-properties-at pos) 'face)))
            (when (and face (or (not defined-only) (symbolp face)))
              (puthash face t faces))))
        (hash-keys faces)))))


(defun all-buffer-faces ()
  "Returns a list of all known faces that are used in all buffers."
  (reduce 'cl-nunion (mapcar (lambda (b) (buffer-faces b t)) (buffer-list))))


(defun show-me-all-used-faces (&optional pretty)
  "Displays a buffer of all currently used faces in all buffers.
The name of the faces are displayed using the faces themself.
With a prefix argument, list them out in an animated fashion."
  (interactive "P")
  (switch-to-buffer (get-buffer-create "*My Used Faces*"))
  (read-only-mode t)
  (let ((inhibit-read-only t)
        (n 0))
    (delete-region (point-min) (point-max))
    (dolist (face (sort (all-buffer-faces) (lambda (a b) (string< (symbol-name a) (symbol-name b)))))
      (insert (format "%45s%15s\n" (symbol-name face) (propertize "Hello, World!" 'face face)))
      (when (and pretty (= 0 (mod (incf n) 3)))
        (sleep-for 0 5)
        (recenter -1)
        (redisplay t)))))