code.delx.au - gnu-emacs-elpa/blob - packages/auto-overlays/auto-overlay-word.el

   1 ;;; auto-overlay-word.el --- automatic overlays for single "words"
   2
   3
   4 ;; Copyright (C) 2005-2015  Free Software Foundation, Inc
   5
   6 ;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
   7 ;; Maintainer: Toby Cubitt <toby-predictive@dr-qubit.org>
   8 ;; URL: http://www.dr-qubit.org/emacs.php
   9 ;; Repository: http://www.dr-qubit.org/git/predictive.git
  10
  11 ;; This file is part of the Emacs.
  12 ;;
  13 ;; This file is free software: you can redistribute it and/or modify it under
  14 ;; the terms of the GNU General Public License as published by the Free
  15 ;; Software Foundation, either version 3 of the License, or (at your option)
  16 ;; any later version.
  17 ;;
  18 ;; This program is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  20 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  21 ;; more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License along
  24 ;; with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26
  27 ;;; Code:
  28
  29 (require 'auto-overlays)
  30 (provide 'auto-overlay-word)
  31
  32
  33 ;; set word overlay parsing and suicide functions
  34 (put 'word 'auto-overlay-parse-function 'auto-o-parse-word-match)
  35 (put 'word 'auto-overlay-suicide-function
  36      (lambda (o) (auto-o-delete-overlay (overlay-get o 'parent))))
  37
  38
  39
  40 (defun auto-o-parse-word-match (o-match)
  41   ;; Create a new word overlay for new word match
  42   (let ((o-new (make-overlay (overlay-get o-match 'delim-start)
  43                              (overlay-get o-match 'delim-end)
  44                              nil nil 'rear-advance)))
  45     ;; give overlays appropriate properties
  46     (overlay-put o-new 'auto-overlay t)
  47     (overlay-put o-new 'set-id (overlay-get o-match 'set-id))
  48     (overlay-put o-new 'definition-id (overlay-get o-match 'definition-id))
  49     (overlay-put o-new 'start o-match)
  50     (overlay-put o-match 'parent o-new)
  51     ;; bundle properties inside list if not already, then update overlay
  52     ;; properties
  53     (let ((props (auto-o-props o-match)))
  54       (when (symbolp (car props)) (setq props (list props)))
  55       (dolist (p (auto-o-props o-match))
  56         (overlay-put o-new (car p) (cdr p))))
  57
  58     ;; if new overlay is exclusive, delete lower priority overlays within it
  59     (when (and (overlay-get o-new 'exclusive)
  60                (/= (overlay-start o-new) (overlay-end o-new)))
  61       (auto-o-update-exclusive (overlay-get o-new 'set)
  62                                (overlay-start o-new) (overlay-end o-new)
  63                                nil (overlay-get o-new 'priority)))
  64
  65     ;; return new overlay
  66     o-new)
  67 )
  68
  69
  70 ;; auto-overlay-word.el ends here