311 lines
12 KiB
EmacsLisp
311 lines
12 KiB
EmacsLisp
;;; mumamo-regions.el --- user defined regions with mumamo
|
|
;;
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
|
;; Created: 2009-05-31 Sun
|
|
;; Version: 0.5
|
|
;; Last-Updated: 2009-06-01 Mon
|
|
;; URL:
|
|
;; Keywords:
|
|
;; Compatibility:
|
|
;;
|
|
;; Features that might be required by this library:
|
|
;;
|
|
;; None
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; Add temporary mumamo chunks (called mumamo regions). This are
|
|
;; added interactively from a highlighted region.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Change log:
|
|
;;
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; 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:
|
|
|
|
(eval-when-compile (require 'cl))
|
|
(eval-when-compile (require 'mumamo))
|
|
(eval-when-compile (require 'ourcomments-widgets))
|
|
(require 'ps-print) ;; For ps-print-ensure-fontified
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; Internal side functions etc
|
|
|
|
(defvar mumamo-regions nil
|
|
"List of active mumamo regions. Internal use only.
|
|
The entries in this list should be like this
|
|
|
|
\(OVL-DEF OVL-CHUNK)
|
|
|
|
where OVL-DEF is an overlay containing the definitions, ie `major-mode'.
|
|
OVL-CHUNK is the definitions set up temporarily for mumamo chunks.
|
|
|
|
The fontification functions in mumamo looks in this list, but the
|
|
chunk dividing functions defined by
|
|
`define-mumamo-multi-major-mode' does not. The effect is that
|
|
the normal chunks exists regardless of what is in this list, but
|
|
fontification etc is overridden by what this list says.")
|
|
(make-variable-buffer-local 'mumamo-regions)
|
|
(put 'mumamo-regions 'permanent-local t)
|
|
|
|
(defun mumamo-add-region-1 (major start end buffer)
|
|
"Add a mumamo region with major mode MAJOR from START to END.
|
|
Return the region. The returned value can be used in
|
|
`mumamo-clear-region'.
|
|
|
|
START and END should be markers in the buffer BUFFER. They may
|
|
also be nil in which case they extend the region to the buffer
|
|
boundaries."
|
|
(unless mumamo-multi-major-mode
|
|
(mumamo-temporary-multi-major))
|
|
(or (not start)
|
|
(markerp start)
|
|
(eq (marker-buffer start) buffer)
|
|
(error "Bad arg start: %s" start))
|
|
(or (not end)
|
|
(markerp end)
|
|
(eq (marker-buffer end) buffer)
|
|
(error "Bad arg end: %s" end))
|
|
(let ((ovl (make-overlay start end)))
|
|
(overlay-put ovl 'mumamo-region 'defined)
|
|
(overlay-put ovl 'face 'mumamo-region)
|
|
(overlay-put ovl 'priority 2)
|
|
(mumamo-region-set-major ovl major)
|
|
(setq mumamo-regions (cons (list ovl nil) mumamo-regions))
|
|
(mumamo-mark-for-refontification (overlay-start ovl) (overlay-end ovl))
|
|
(message "Added mumamo region from %d to %d" (+ 0 start) (+ 0 end))
|
|
ovl))
|
|
|
|
(defun mumamo-clear-region-1 (region-entry)
|
|
"Clear mumamo region REGION-ENTRY.
|
|
The entry must have been returned from `mumamo-add-region-1'."
|
|
(let ((buffer (overlay-buffer (car region-entry)))
|
|
(entry (cdr region-entry)))
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(let ((ovl1 (car region-entry))
|
|
(ovl2 (cadr region-entry)))
|
|
(delete-overlay ovl1)
|
|
(when ovl2
|
|
(mumamo-mark-for-refontification (overlay-start ovl2) (overlay-end ovl2))
|
|
(delete-overlay ovl2))
|
|
(setq mumamo-regions (delete region-entry mumamo-regions)))))))
|
|
|
|
(defvar mumamo-region-priority 0)
|
|
(make-variable-buffer-local 'mumamo-region-priority)
|
|
(put 'mumamo-region-priority 'permanent-local t)
|
|
|
|
(defun mumamo-get-region-from-1 (point)
|
|
"Return mumamo region values for POINT.
|
|
The return value is either mumamo chunk or a cons with
|
|
information about where regions starts to hide normal chunks.
|
|
Such a cons has the format \(BELOW . OVER) where each of them is
|
|
a position or nil."
|
|
(when mumamo-regions
|
|
(save-restriction
|
|
(widen)
|
|
(let* ((start nil)
|
|
(end nil)
|
|
(major nil)
|
|
hit-reg
|
|
ret-val)
|
|
(catch 'found-major
|
|
(dolist (reg mumamo-regions)
|
|
(assert (eq (overlay-get (car reg) 'mumamo-region) 'defined) t)
|
|
(assert (or (not (cadr reg)) (overlayp (cadr reg))))
|
|
(let* ((this-ovl (car reg))
|
|
(this-start (overlay-start this-ovl))
|
|
(this-end (overlay-end this-ovl)))
|
|
(when (<= this-end point)
|
|
(setq start this-end))
|
|
(when (< point this-start)
|
|
(setq end this-start))
|
|
(when (and (<= this-start point)
|
|
(< point this-end))
|
|
(setq major (overlay-get this-ovl 'mumamo-major-mode))
|
|
(setq start (max this-start (or start this-start)))
|
|
(setq end (min this-end (or end this-end)))
|
|
(setq hit-reg reg)
|
|
(throw 'found-major nil)))))
|
|
(if major
|
|
(progn
|
|
(setq ret-val (nth 1 hit-reg))
|
|
(when ret-val (assert (eq (overlay-get ret-val 'mumamo-region) 'used) t))
|
|
(if ret-val
|
|
(move-overlay ret-val start end)
|
|
(setq ret-val (make-overlay start end nil t nil)) ;; fix-me
|
|
(setcar (cdr hit-reg) ret-val)
|
|
(overlay-put ret-val 'mumamo-region 'used)
|
|
(overlay-put ret-val 'priority ;; above normal chunks + chunks on chunks
|
|
(setq mumamo-region-priority (1+ mumamo-region-priority)))
|
|
;;(overlay-put ret-val 'face '(:background "chocolate")) ;; temporary
|
|
(overlay-put ret-val 'mumamo-major-mode
|
|
(overlay-get (car hit-reg) 'mumamo-major-mode))))
|
|
(setq ret-val (cons start end)))
|
|
;;(message "mumamo-get-region-from-1, point=%s ret-val=%s" point ret-val)
|
|
ret-val))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; User side functions
|
|
|
|
(defun mumamo-temporary-multi-major ()
|
|
"Turn on a temporary multi major mode from buffers current mode.
|
|
Define one if no one exists. It will have no chunk dividing
|
|
routines. It is meant mainly to be used with mumamo regions when
|
|
there is no mumamo multi major mode in the buffer and the user
|
|
wants to add a mumamo region \(which requires a multi major mode
|
|
to work)."
|
|
(when mumamo-multi-major-mode
|
|
(error "Mumamo is already active in buffer"))
|
|
(let* ((temp-mode-name (concat "mumamo-1-"
|
|
(symbol-name major-mode)))
|
|
(temp-mode-sym (intern-soft temp-mode-name)))
|
|
(unless (and temp-mode-sym
|
|
(fboundp temp-mode-sym))
|
|
(setq temp-mode-sym (intern temp-mode-name))
|
|
(eval
|
|
`(define-mumamo-multi-major-mode ,temp-mode-sym
|
|
"Temporary multi major mode."
|
|
("Temporary" ,major-mode nil))))
|
|
(put temp-mode-sym 'mumamo-temporary major-mode)
|
|
(funcall temp-mode-sym)))
|
|
|
|
(defface mumamo-region
|
|
'((t (:background "white")))
|
|
"Face for mumamo-region regions."
|
|
:group 'mumamo)
|
|
|
|
;;;###autoload
|
|
(defun mumamo-add-region ()
|
|
"Add a mumamo region from selection.
|
|
Mumamo regions are like another layer of chunks above the normal chunks.
|
|
They does not affect the normal chunks, but they overrides them.
|
|
|
|
To create a mumamo region first select a visible region and then
|
|
call this function.
|
|
|
|
If the buffer is not in a multi major mode a temporary multi
|
|
major mode will be created applied to the buffer first.
|
|
To get out of this and get back to a single major mode just use
|
|
|
|
M-x normal-mode"
|
|
(interactive)
|
|
(if (not mark-active)
|
|
(message (propertize "Please select a visible region first" 'face 'secondary-selection))
|
|
(let ((beg (region-beginning))
|
|
(end (region-end))
|
|
(maj (mumamo-region-read-major)))
|
|
(mumamo-add-region-1 maj (copy-marker beg) (copy-marker end) (current-buffer))
|
|
(setq deactivate-mark t))))
|
|
|
|
;;;###autoload
|
|
(defun mumamo-add-region-from-string ()
|
|
"Add a mumamo region from string at point.
|
|
Works as `mumamo-add-region' but for string or comment at point.
|
|
|
|
Buffer must be fontified."
|
|
(interactive)
|
|
;; assure font locked.
|
|
(require 'ps-print)
|
|
(ps-print-ensure-fontified (point-min) (point-max))
|
|
(let ((the-face (get-text-property (point) 'face)))
|
|
(if (not (memq the-face
|
|
'(font-lock-doc-face
|
|
font-lock-string-face
|
|
font-lock-comment-face)))
|
|
(message "No string or comment at point")
|
|
(let ((beg (previous-single-property-change (point) 'face))
|
|
(end (next-single-property-change (point) 'face))
|
|
(maj (mumamo-region-read-major)))
|
|
(setq beg (or (when beg (1+ beg))
|
|
(point-min)))
|
|
(setq end (or (when end (1- end))
|
|
(point-max)))
|
|
(mumamo-add-region-1 maj (copy-marker beg) (copy-marker end) (current-buffer))))))
|
|
;; (dolist (o (overlays-in (point-min) (point-max))) (delete-overlay o))
|
|
(defun mumamo-clear-all-regions ()
|
|
"Clear all mumamo regions in buffer.
|
|
For information about mumamo regions see `mumamo-add-region'."
|
|
(interactive)
|
|
(unless mumamo-multi-major-mode
|
|
(error "There can be no mumamo regions to clear unless in multi major modes"))
|
|
(while mumamo-regions
|
|
(mumamo-clear-region-1 (car mumamo-regions))
|
|
(setq mumamo-regions (cdr mumamo-regions)))
|
|
(let ((old (get mumamo-multi-major-mode 'mumamo-temporary)))
|
|
(when old (funcall old)))
|
|
(message "Cleared all mumamo regions"))
|
|
|
|
(defun mumamo-region-read-major ()
|
|
"Prompt user for major mode.
|
|
Accept only single major mode, not mumamo multi major modes."
|
|
(let ((major (read-command "Major mode: ")))
|
|
(unless (major-modep major) (error "Not a major mode: %s" major))
|
|
(when (mumamo-multi-major-modep major) (error "Multi major modes not allowed: %s" major))
|
|
(when (let ((major-mode major))
|
|
(derived-mode-p 'nxml-mode))
|
|
(error "%s is based on nxml-mode and can't be used here" major))
|
|
major))
|
|
|
|
(defun mumamo-region-at (point)
|
|
"Return mumamo region at POINT."
|
|
(let ((ovls (overlays-at (point))))
|
|
(catch 'overlay
|
|
(dolist (o ovls)
|
|
(when (overlay-get o 'mumamo-region)
|
|
(throw 'overlay o)))
|
|
nil)))
|
|
|
|
(defun mumamo-region-set-major (ovl major)
|
|
"Change major mode for mumamo region at point.
|
|
For information about mumamo regions see `mumamo-add-region'.
|
|
|
|
If run non-interactively then OVL should be a mumamo region and
|
|
MAJOR the major mode to set for that region."
|
|
(interactive
|
|
(list (or (mumamo-region-at (point))
|
|
(error "There is no mumamo region at point"))
|
|
(mumamo-region-read-major)))
|
|
(overlay-put ovl 'mumamo-major-mode `(,major))
|
|
(overlay-put ovl 'help-echo (format "Mumamo region, major mode `%s'" major)))
|
|
|
|
(defun mumamo-clear-region (ovl)
|
|
"Clear the mumamo region at point.
|
|
For information about mumamo regions see `mumamo-add-region'.
|
|
|
|
If run non-interactively then OVL should be the mumamo region to
|
|
clear."
|
|
(interactive
|
|
(list (or (mumamo-region-at (point))
|
|
(error "There is no mumamo region at point"))))
|
|
(let ((region-entry (rassoc (list ovl) mumamo-regions)))
|
|
(unless region-entry
|
|
(error "No mumamo region found at point"))
|
|
(mumamo-clear-region-1 region-entry)))
|
|
|
|
|
|
(provide 'mumamo-regions)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; mumamo-regions.el ends here
|