From 94d2fc1815a919734353c942f224db1de4b4fcb8 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Mon, 7 Mar 2011 09:04:49 +0100 Subject: Django, org * Added nxhtml, mostly for django support. * Changed some org settings. --- emacs.d/nxhtml/util/foldit.el | 357 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 357 insertions(+) create mode 100644 emacs.d/nxhtml/util/foldit.el (limited to 'emacs.d/nxhtml/util/foldit.el') diff --git a/emacs.d/nxhtml/util/foldit.el b/emacs.d/nxhtml/util/foldit.el new file mode 100644 index 0000000..0ffacc3 --- /dev/null +++ b/emacs.d/nxhtml/util/foldit.el @@ -0,0 +1,357 @@ +;;; foldit.el --- Helpers for folding +;; +;; Author: Lennart Borgman (lennart O borgman A gmail O com) +;; Created: 2009-08-10 Mon +;; Version: +;; Last-Updated: +;; URL: +;; Keywords: +;; Compatibility: +;; +;; Features that might be required by this library: +;; +;; None +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Defines `foldit-mode' which puts visual clues on hidden regions. +;; Does not do any folding itself but works with `outline-minor-mode' +;; and `hs-minor-mode'. +;; +;; Fix-me: reveal-mode does not work with this and I have no idea why +;; ... +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; 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: + +;; Fix-me: start-tag-beg/start-tag-end are workarounds for smaller +;; bugs in hs-minor-mode and outline-minor-mode. Maybe try to fix +;; them... - but there are a whole bunch of other invisibilty related +;; bugs that ought to be fixed first since otherwise it is impossible +;; to know where point goes after hiding/unhiding. + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'hideshow)) +(eval-when-compile (require 'mumamo nil t)) +(eval-when-compile (require 'outline)) + +(defsubst foldit-overlay-priority () + (1+ (or (and (boundp 'mlinks-link-overlay-priority) + mlinks-link-overlay-priority) + 100))) + +;;;###autoload +(defgroup foldit nil + "Customization group for foldit folding helpers." + :group 'nxhtml) + +(defvar foldit-temp-at-point-ovl nil) +(make-variable-buffer-local 'foldit-temp-at-point-ovl) + +;;;###autoload +(define-minor-mode foldit-mode + "Minor mode providing visual aids for folding. +Shows some hints about what you have hidden and how to reveal it. + +Supports `hs-minor-mode', `outline-minor-mode' and major modes +derived from `outline-mode'." + :lighter nil + (if foldit-mode + (progn + ;; Outline + (add-hook 'outline-view-change-hook 'foldit-outline-change nil t) + ;; Add our overlays + (when (or (and (boundp 'outline-minor-mode) outline-minor-mode) + ;; Fix-me: mumamo + (derived-mode-p 'outline-mode)) (foldit-outline-change)) + ;; hs + (unless (local-variable-p 'hs-set-up-overlay) + (set (make-local-variable 'hs-set-up-overlay) 'foldit-hs-set-up-overlay)) + ;; Add our overlays + (when (or (and (boundp 'hs-minor-mode) hs-minor-mode)) + (save-restriction + (widen) + (let (ovl) + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (eq (overlay-get ovl 'invisible) 'hs) + (funcall hs-set-up-overlay ovl))))))) + ;; Outline + (remove-hook 'outline-view-change-hook 'foldit-outline-change t) + ;; hs + (when (and (local-variable-p 'hs-set-up-overlay) + (eq hs-set-up-overlay 'foldit-hs-set-up-overlay)) + (kill-local-variable 'hs-set-up-overlay)) + ;; Remove our overlays + (save-restriction + (widen) + (let (ovl prop) + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (setq prop (overlay-get ovl 'foldit)) + (case prop + ;;('display (overlay-put ovl 'display nil)) + ('foldit (delete-overlay ovl)) + (t (delete-overlay ovl)) + ))))))) + +(defcustom foldit-avoid '(org-mode) + "List of major modes to avoid." + :group 'foldit) + +;;;###autoload +(define-globalized-minor-mode foldit-global-mode foldit-mode + (lambda () (foldit-mode 1)) + :group 'foldit) + +(defun foldit-hidden-line-str (hidden-lines type) + "String to display for hidden lines. +HIDDEN-LINES are the number of lines and TYPE is a string +indicating how they were hidden." + (propertize (format " ...(%d %slines)" hidden-lines type) + 'face 'shadow)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Outline + +(defvar foldit-outline-keymap + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'foldit-outline-show-entry) + (define-key map [down-mouse-1] 'foldit-outline-show-entry) + (define-key map [S-tab] 'mlinks-backward-link) + (define-key map [tab] 'mlinks-forward-link) + (define-key map "\t" 'mlinks-forward-link) + map)) + +(defun foldit-outline-change () + "Check outline overlays. +Run this in `outline-view-change-hook'." + ;; We get the variables FROM and TO here from `outline-flag-region' + ;; so let us use them. But O is hidden... + (let* (from + to + num-lines + ovl + (tag "")) + (cond + ((and (boundp 'start) + start + (boundp 'end) + end) + (setq from start) + (setq to end)) + (t + (setq from (point-min)) + (setq to (point-max)))) + (dolist (ovl (overlays-in from to)) + (when (eq (overlay-get ovl 'invisible) 'outline) + (setq num-lines (count-lines (overlay-start ovl) (overlay-end ovl))) + (overlay-put ovl 'display (concat + (propertize "+" 'face 'mode-line) + "" + tag (foldit-hidden-line-str num-lines ""))) + (overlay-put ovl 'foldit 'display) ;; Should be a list... + (overlay-put ovl 'keymap foldit-outline-keymap) + (overlay-put ovl 'face 'lazy-highlight) + (overlay-put ovl 'mouse-face 'highlight) + (overlay-put ovl 'help-echo "Press RET to show hidden part") + (overlay-put ovl 'mlinks-link t) + (overlay-put ovl 'priority (foldit-overlay-priority)) + (mumamo-with-buffer-prepared-for-jit-lock + (let* ((start-tag-beg (overlay-start ovl)) + (start-tag-end start-tag-beg)) + (put-text-property start-tag-beg (+ start-tag-beg 1) + 'foldit-tag-end (copy-marker start-tag-end)))) + )))) + +(defvar foldit-outline-hide-again-keymap + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'foldit-outline-hide-again) + (define-key map [down-mouse-1] 'foldit-outline-hide-again) + (define-key map [S-tab] 'mlinks-backward-link) + (define-key map [tab] 'mlinks-forward-link) + (define-key map "\t" 'mlinks-forward-link) + map)) + +(defun foldit-outline-show-entry () + "Show hidden entry." + (interactive) + (let ((tag-end (get-text-property (point) 'foldit-tag-end))) + (show-entry) + (mumamo-with-buffer-prepared-for-jit-lock + (set-text-properties (point) (+ (point) 2) 'foldit-tag-end)) + (when tag-end (goto-char tag-end)) + (foldit-add-temp-at-point-overlay "-" + foldit-outline-hide-again-keymap + "Press RET to hide again"))) + +(defun foldit-outline-hide-again () + "Hide entry again." + (interactive) + (when (overlayp foldit-temp-at-point-ovl) + (delete-overlay foldit-temp-at-point-ovl)) + (hide-entry)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Hide/Show + +(defvar foldit-hs-start-tag-end-func 'foldit-hs-default-start-tag-end) +(make-variable-buffer-local 'foldit-hs-start-tag-end-func) +(put 'foldit-hs-start-tag-end-func 'permanent-local t) + +(defun foldit-hs-default-start-tag-end (beg) + "Find end of hide/show tag beginning at BEG." + (min (+ beg 65) + (save-excursion + (goto-char beg) + (line-end-position)))) + +(defvar foldit-hs-keymap + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'foldit-hs-show-block) + (define-key map [down-mouse-1] 'foldit-hs-show-block) + (define-key map [S-tab] 'mlinks-backward-link) + (define-key map [tab] 'mlinks-forward-link) + (define-key map "\t" 'mlinks-forward-link) + map)) + +(defvar foldit-hs-hide-again-keymap + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'foldit-hs-hide-again) + (define-key map [down-mouse-1] 'foldit-hs-hide-again) + (define-key map [S-tab] 'mlinks-backward-link) + (define-key map [tab] 'mlinks-forward-link) + (define-key map "\t" 'mlinks-forward-link) + map)) + +(defun foldit-hs-set-up-overlay (ovl) + "Set up overlay OVL for hide/show." + (let* ((num-lines (count-lines (overlay-start ovl) (overlay-end ovl))) + (here (point)) + (start-tag-beg (overlay-start ovl)) + (start-tag-end (funcall foldit-hs-start-tag-end-func start-tag-beg)) + (tag (buffer-substring start-tag-beg start-tag-end))) + (goto-char here) + ;;(overlay-put ovl 'isearch-open-invisible t) + (overlay-put ovl 'display (concat + (propertize "+" 'face 'mode-line) + " " + tag (foldit-hidden-line-str num-lines "h"))) + (overlay-put ovl 'foldit 'display) + (overlay-put ovl 'keymap foldit-hs-keymap) + (overlay-put ovl 'face 'next-error) + (overlay-put ovl 'face 'lazy-highlight) + (overlay-put ovl 'mouse-face 'highlight) + (overlay-put ovl 'help-echo "Press RET to show hidden part") + (overlay-put ovl 'mlinks-link t) + (overlay-put ovl 'priority (foldit-overlay-priority)) + (mumamo-with-buffer-prepared-for-jit-lock + (put-text-property start-tag-beg (+ start-tag-beg 1) + 'foldit-tag-end (copy-marker start-tag-end))))) + +(defun foldit-hs-show-block () + "Show hidden block." + (interactive) + (let ((tag-end (get-text-property (point) 'foldit-tag-end))) + (hs-show-block) + (mumamo-with-buffer-prepared-for-jit-lock + (set-text-properties (point) (+ (point) 2) 'foldit-tag-end)) + (when tag-end (goto-char tag-end)) + (foldit-add-temp-at-point-overlay "-" + foldit-hs-hide-again-keymap + "Press RET to hide again"))) + +(defun foldit-hs-hide-again () + "Hide hide/show block again." + (interactive) + (when (overlayp foldit-temp-at-point-ovl) + (delete-overlay foldit-temp-at-point-ovl)) + (hs-hide-block)) + + +;;; Fix-me: break out this +;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +(defun foldit-add-temp-at-point-overlay (marker keymap msg) + "Add a temporary overlay with a marker MARKER and a keymap KEYMAP. +The overlay is also given the help echo MSG. + +This overlay is removed as soon as point moves from current point." + (let ((ovl (make-overlay (point) (1+ (point)))) + (real (buffer-substring (point) (1+ (point))))) + (overlay-put ovl 'isearch-open-invisible t) + (overlay-put ovl 'display (concat + (propertize marker 'face 'mode-line) + " " + msg + real)) + (overlay-put ovl 'foldit 'foldit) + (overlay-put ovl 'keymap keymap) + (overlay-put ovl 'face 'lazy-highlight) + (overlay-put ovl 'mouse-face 'highlight) + (overlay-put ovl 'help-echo msg) + (overlay-put ovl 'mlinks-link t) + (overlay-put ovl 'priority (foldit-overlay-priority)) + (setq foldit-temp-at-point-ovl ovl) + (add-hook 'post-command-hook + 'foldit-remove-temp-at-point-overlay + nil t))) + +(defun foldit-remove-temp-at-point-overlay () + "Remove overlay made by `foldit-add-temp-at-point-overlay'." + (condition-case err + (unless (and foldit-temp-at-point-ovl + (overlay-buffer foldit-temp-at-point-ovl) + (= (overlay-start foldit-temp-at-point-ovl) + (point))) + (delete-overlay foldit-temp-at-point-ovl) + (setq foldit-temp-at-point-ovl nil) + (remove-hook 'post-command-hook 'foldit-remove-temp-at-point-overlay t) + ) + (error (message "foldit-remove-temp-at-point-overlay: %s" + (propertize (error-message-string err)))))) +;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + +;; (defun put-before-on-invis () +;; (let* (o +;; (io (catch 'io +;; (dolist (o (overlays-at (1+ (point)))) +;; (when (overlay-get o 'invisible) +;; (throw 'io o))))) +;; (str (propertize "IOSTRING" +;; 'face 'secondary-selection +;; ))) +;; (overlay-put io 'before-string str) +;; ;;(overlay-put io 'display "display") +;; (overlay-put io 'display nil) +;; ;;(overlay-put io 'after-string "AFTER") +;; )) + +(provide 'foldit) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; foldit.el ends here -- cgit v1.2.3-54-g00ecf