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

   1 ;;; auto-overlay-line.el --- automatic overlays for single lines
   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-line)
  31
  32
  33 ;; set line overlay parsing and suicide funtions
  34 (put 'line 'auto-overlay-parse-function 'auto-o-parse-line-match)
  35 (put 'line 'auto-overlay-suicide-function
  36      (lambda (o) (auto-o-delete-overlay (overlay-get o 'parent))))
  37
  38
  39
  40 (defun auto-o-parse-line-match (o-match)
  41   ;; Create overlay for a new line match.
  42   (let ((o-new (make-overlay (overlay-get o-match 'delim-end)
  43                              (save-excursion
  44                                (goto-char (overlay-get o-match 'delim-end))
  45                                (1+ (line-end-position))))))
  46
  47     ;; give new overlay some basic properties
  48     (overlay-put o-new 'auto-overlay t)
  49     (overlay-put o-new 'set-id (overlay-get o-match 'set-id))
  50     (overlay-put o-new 'definition-id (overlay-get o-match 'definition-id))
  51     ;; match start of new overlay with match
  52     (auto-o-match-overlay o-new o-match nil)
  53     ;; set overlay's modification hooks to ensure that it always extends to
  54     ;; end of line
  55     (overlay-put o-new 'modification-hooks
  56                  (cons 'auto-o-schedule-extend-line
  57                        (overlay-get o-new 'modification-hooks)))
  58     ;; return new overlay
  59     o-new))
  60
  61
  62 (defun auto-o-schedule-extend-line (o-self modified &rest unused)
  63   ;; All line overlay modification hooks are set to this function, which
  64   ;; schedules `auto-o-extend-line' to run after any suicide functions have
  65   ;; been called, but before the overlays are updated.
  66   (unless modified
  67     (push (list 'auto-o-extend-line o-self) auto-o-pending-post-suicide)))
  68
  69
  70
  71 (defun auto-o-extend-line (o-self)
  72   ;; Checks if overlay still extends to end of line, and update the necessary
  73   ;; if not.
  74
  75   ;; if we haven't been deleted by a suicide function...
  76   (when (overlay-buffer o-self)
  77     (save-match-data
  78       (let ((start (overlay-start o-self))
  79             (end (overlay-end o-self)))
  80         (cond
  81          ;; if we no longer extend to end of line...
  82          ((null (string-match "\n" (buffer-substring-no-properties
  83                                     (overlay-start o-self)
  84                                     (overlay-end o-self))))
  85           ;; grow ourselves so we extend till end of line
  86           (move-overlay o-self start (save-excursion
  87                                        (goto-char (overlay-end o-self))
  88                                        (1+ (line-end-position))))
  89           ;; if we're exclusive, delete lower priority overlays in newly
  90           ;; covered region
  91           (auto-o-update-exclusive (overlay-get o-self 'set-id)
  92                                    end (overlay-end o-self)
  93                                    nil (overlay-get o-self 'priority)))
  94
  95          ;; if we extend beyond end of line...
  96          ((/= (overlay-end o-self) (+ start (match-end 0)))
  97           ;; shrink ourselves so we extend till end of line
  98           (move-overlay o-self start (+ start (match-end 0)))
  99           ;; if we're exclusive, re-parse region that is no longer covered
 100           (auto-o-update-exclusive (overlay-get o-self 'set-id)
 101                                    (overlay-end o-self) end
 102                                    (overlay-get o-self 'priority) nil))
 103          )))))
 104
 105
 106 ;; auto-overlay-line.el ends here