;;; ovab.el
;;;
;;; Copyright (C) 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: Overl{a}y abbreviate default-directory and other things.

(require 'cl)

(defvar ovab-alist t
  "Specification for command `ovab'.
If a non-cons ELEM, it is taken as the list (ELEM).
Each non-cons ELEM in the list is taken as the pair (ELEM . \"\").
If ELEM is `t' it is taken as the pair (CWD . \"\"),
 where CWD is the value of `(expand-file-name default-directory)'.
If ELEM is not a string, it is taken as the pair (STR . \"\"),
 where STR is the value of `(format \"%S\" ELEM)'.
Otherwise each ELEM should be a pair of strings (FULL . ABBREV).")

;;;###autoload
(defun ovab (&optional clear)
  "Overl{a}y abbreviate the current buffer according to `ovab-alist'.
Sort the pairs of strings (FULL . ABBREV) by the length of FULL
in decreasing order, and create an overlay for each FULL found
in the buffer with `display' property the associated ABBREV.

Prefix arg means to remove all `ovab'-created overlays, instead.

All operations respect narrowing."
  (interactive "P")
  (remove-overlays nil nil 'ovab t)
  (unless clear
    (let* ((alist (if (consp ovab-alist)
                      ovab-alist
                    (list ovab-alist)))
           (normal (mapcar (lambda (elem)
                             (if (consp elem)
                                 elem
                               (cons (cond ((stringp elem) elem)
                                           ((eq t elem) (expand-file-name
                                                         default-directory))
                                           (t (format "%S" elem)))
                                     "")))
                           alist))
           (changes (sort normal (lambda (a b)
                                   (> (length (car a))
                                      (length (car b)))))))
      (overlay-recenter (point-max))
      (save-excursion
        (dolist (change changes)
          (goto-char (point-min))
          (while (search-forward (car change) nil t)
            (let* ((beg (match-beginning 0))
                   (end (match-end 0))
                   (cur (delete-if-not (lambda (ov)
                                         (overlay-get ov 'ovab))
                                       (overlays-in beg end)))
                   (ov (unless cur
                         (make-overlay beg end))))
              (when ov
                (overlay-put ov 'ovab t)
                (overlay-put ov 'display (cdr change))))))))))

(provide 'ovab)

;;; ovab.el ends here