;;; set-font-at-point.el
;;;
;;; Copyright (C) 1997, 1998, 2002, 2004, 2006, 2007, 2008 Thien-Thi Nguyen
;;;
;;; This file is part of ttn's personal elisp library, released 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.  There is NO WARRANTY.  See file COPYING for details.

;;; Description: Set font at cursor position, useful w/ xlsfonts(1) output.
;;; If cursor doesn't seem to be on a font, do "xlsfonts".
;;;
;;; TODO: Ensure setting of `bold'.

(require 'strip)

;;;###autoload
(defun xlsfonts ()
  "Displays xlsfonts(1) output in a buffer.  RET sets default font.
SPC and DEL scroll up and down, respectively."
  (interactive)
  (let ((buf (switch-to-buffer (get-buffer-create "*set-font-at-point*"))))
    (when (= 1 (point-max))
      (call-process "xlsfonts" nil t nil))
    (goto-char 1)                       ; todo: heuristic
    (setq major-mode 'choose)           ; todo: go electric
    (setq mode-name "choose")
    (use-local-map (let ((map (make-sparse-keymap)))
                     (define-keys map
                       '("\C-m" set-font-at-point
                         " "    scroll-up
                         "\C-?" scroll-down))
                     map))))

;;;###autoload
(defun set-font-at-point (p)
  "Set default font based on point.  Manually re-enters with list if error."
  (interactive "p")
  (let* ((e (progn (end-of-line) (point)))
         (b (progn (beginning-of-line) (point)))
         (font (strip (buffer-substring b e))))
    (condition-case nil                 ; todo: make into advice
        (set-default-font font)
      (error (xlsfonts)))
    (forward-line 1)))

;;;###autoload
(defalias 'browse-x-fonts 'xlsfonts)

(provide 'set-font-at-point)

;;; set-font-at-point.el ends here