PageRenderTime 54ms CodeModel.GetById 27ms RepoModel.GetById 1ms app.codeStats 0ms

/bdw/emacs/nxhtml/util/foldit.el

https://github.com/bretweinraub/bash_profiles
Emacs Lisp | 357 lines | 231 code | 33 blank | 93 comment | 4 complexity | 43e94253a01d9d6e2b7ad02becc10474 MD5 | raw file
  1. ;;; foldit.el --- Helpers for folding
  2. ;;
  3. ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
  4. ;; Created: 2009-08-10 Mon
  5. ;; Version:
  6. ;; Last-Updated:
  7. ;; URL:
  8. ;; Keywords:
  9. ;; Compatibility:
  10. ;;
  11. ;; Features that might be required by this library:
  12. ;;
  13. ;; None
  14. ;;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16. ;;
  17. ;;; Commentary:
  18. ;;
  19. ;; Defines `foldit-mode' which puts visual clues on hidden regions.
  20. ;; Does not do any folding itself but works with `outline-minor-mode'
  21. ;; and `hs-minor-mode'.
  22. ;;
  23. ;; Fix-me: reveal-mode does not work with this and I have no idea why
  24. ;; ...
  25. ;;
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;;
  28. ;;; Change log:
  29. ;;
  30. ;;
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;;
  33. ;; This program is free software; you can redistribute it and/or
  34. ;; modify it under the terms of the GNU General Public License as
  35. ;; published by the Free Software Foundation; either version 3, or
  36. ;; (at your option) any later version.
  37. ;;
  38. ;; This program is distributed in the hope that it will be useful,
  39. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  40. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  41. ;; General Public License for more details.
  42. ;;
  43. ;; You should have received a copy of the GNU General Public License
  44. ;; along with this program; see the file COPYING. If not, write to
  45. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  46. ;; Floor, Boston, MA 02110-1301, USA.
  47. ;;
  48. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49. ;;
  50. ;;; Code:
  51. ;; Fix-me: start-tag-beg/start-tag-end are workarounds for smaller
  52. ;; bugs in hs-minor-mode and outline-minor-mode. Maybe try to fix
  53. ;; them... - but there are a whole bunch of other invisibilty related
  54. ;; bugs that ought to be fixed first since otherwise it is impossible
  55. ;; to know where point goes after hiding/unhiding.
  56. (eval-when-compile (require 'cl))
  57. (eval-when-compile (require 'hideshow))
  58. (eval-when-compile (require 'mumamo nil t))
  59. (eval-when-compile (require 'outline))
  60. (defsubst foldit-overlay-priority ()
  61. (1+ (or (and (boundp 'mlinks-link-overlay-priority)
  62. mlinks-link-overlay-priority)
  63. 100)))
  64. ;;;###autoload
  65. (defgroup foldit nil
  66. "Customization group for foldit folding helpers."
  67. :group 'nxhtml)
  68. (defvar foldit-temp-at-point-ovl nil)
  69. (make-variable-buffer-local 'foldit-temp-at-point-ovl)
  70. ;;;###autoload
  71. (define-minor-mode foldit-mode
  72. "Minor mode providing visual aids for folding.
  73. Shows some hints about what you have hidden and how to reveal it.
  74. Supports `hs-minor-mode', `outline-minor-mode' and major modes
  75. derived from `outline-mode'."
  76. :lighter nil
  77. (if foldit-mode
  78. (progn
  79. ;; Outline
  80. (add-hook 'outline-view-change-hook 'foldit-outline-change nil t)
  81. ;; Add our overlays
  82. (when (or (and (boundp 'outline-minor-mode) outline-minor-mode)
  83. ;; Fix-me: mumamo
  84. (derived-mode-p 'outline-mode)) (foldit-outline-change))
  85. ;; hs
  86. (unless (local-variable-p 'hs-set-up-overlay)
  87. (set (make-local-variable 'hs-set-up-overlay) 'foldit-hs-set-up-overlay))
  88. ;; Add our overlays
  89. (when (or (and (boundp 'hs-minor-mode) hs-minor-mode))
  90. (save-restriction
  91. (widen)
  92. (let (ovl)
  93. (dolist (ovl (overlays-in (point-min) (point-max)))
  94. (when (eq (overlay-get ovl 'invisible) 'hs)
  95. (funcall hs-set-up-overlay ovl)))))))
  96. ;; Outline
  97. (remove-hook 'outline-view-change-hook 'foldit-outline-change t)
  98. ;; hs
  99. (when (and (local-variable-p 'hs-set-up-overlay)
  100. (eq hs-set-up-overlay 'foldit-hs-set-up-overlay))
  101. (kill-local-variable 'hs-set-up-overlay))
  102. ;; Remove our overlays
  103. (save-restriction
  104. (widen)
  105. (let (ovl prop)
  106. (dolist (ovl (overlays-in (point-min) (point-max)))
  107. (when (setq prop (overlay-get ovl 'foldit))
  108. (case prop
  109. ;;('display (overlay-put ovl 'display nil))
  110. ('foldit (delete-overlay ovl))
  111. (t (delete-overlay ovl))
  112. )))))))
  113. (defcustom foldit-avoid '(org-mode)
  114. "List of major modes to avoid."
  115. :group 'foldit)
  116. ;;;###autoload
  117. (define-globalized-minor-mode foldit-global-mode foldit-mode
  118. (lambda () (foldit-mode 1))
  119. :group 'foldit)
  120. (defun foldit-hidden-line-str (hidden-lines type)
  121. "String to display for hidden lines.
  122. HIDDEN-LINES are the number of lines and TYPE is a string
  123. indicating how they were hidden."
  124. (propertize (format " ...(%d %slines)" hidden-lines type)
  125. 'face 'shadow))
  126. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  127. ;;; Outline
  128. (defvar foldit-outline-keymap
  129. (let ((map (make-sparse-keymap)))
  130. (define-key map "\r" 'foldit-outline-show-entry)
  131. (define-key map [down-mouse-1] 'foldit-outline-show-entry)
  132. (define-key map [S-tab] 'mlinks-backward-link)
  133. (define-key map [tab] 'mlinks-forward-link)
  134. (define-key map "\t" 'mlinks-forward-link)
  135. map))
  136. (defun foldit-outline-change ()
  137. "Check outline overlays.
  138. Run this in `outline-view-change-hook'."
  139. ;; We get the variables FROM and TO here from `outline-flag-region'
  140. ;; so let us use them. But O is hidden...
  141. (let* (from
  142. to
  143. num-lines
  144. ovl
  145. (tag ""))
  146. (cond
  147. ((and (boundp 'start)
  148. start
  149. (boundp 'end)
  150. end)
  151. (setq from start)
  152. (setq to end))
  153. (t
  154. (setq from (point-min))
  155. (setq to (point-max))))
  156. (dolist (ovl (overlays-in from to))
  157. (when (eq (overlay-get ovl 'invisible) 'outline)
  158. (setq num-lines (count-lines (overlay-start ovl) (overlay-end ovl)))
  159. (overlay-put ovl 'display (concat
  160. (propertize "+" 'face 'mode-line)
  161. ""
  162. tag (foldit-hidden-line-str num-lines "")))
  163. (overlay-put ovl 'foldit 'display) ;; Should be a list...
  164. (overlay-put ovl 'keymap foldit-outline-keymap)
  165. (overlay-put ovl 'face 'lazy-highlight)
  166. (overlay-put ovl 'mouse-face 'highlight)
  167. (overlay-put ovl 'help-echo "Press RET to show hidden part")
  168. (overlay-put ovl 'mlinks-link t)
  169. (overlay-put ovl 'priority (foldit-overlay-priority))
  170. (mumamo-with-buffer-prepared-for-jit-lock
  171. (let* ((start-tag-beg (overlay-start ovl))
  172. (start-tag-end start-tag-beg))
  173. (put-text-property start-tag-beg (+ start-tag-beg 1)
  174. 'foldit-tag-end (copy-marker start-tag-end))))
  175. ))))
  176. (defvar foldit-outline-hide-again-keymap
  177. (let ((map (make-sparse-keymap)))
  178. (define-key map "\r" 'foldit-outline-hide-again)
  179. (define-key map [down-mouse-1] 'foldit-outline-hide-again)
  180. (define-key map [S-tab] 'mlinks-backward-link)
  181. (define-key map [tab] 'mlinks-forward-link)
  182. (define-key map "\t" 'mlinks-forward-link)
  183. map))
  184. (defun foldit-outline-show-entry ()
  185. "Show hidden entry."
  186. (interactive)
  187. (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
  188. (show-entry)
  189. (mumamo-with-buffer-prepared-for-jit-lock
  190. (set-text-properties (point) (+ (point) 2) 'foldit-tag-end))
  191. (when tag-end (goto-char tag-end))
  192. (foldit-add-temp-at-point-overlay "-"
  193. foldit-outline-hide-again-keymap
  194. "Press RET to hide again")))
  195. (defun foldit-outline-hide-again ()
  196. "Hide entry again."
  197. (interactive)
  198. (when (overlayp foldit-temp-at-point-ovl)
  199. (delete-overlay foldit-temp-at-point-ovl))
  200. (hide-entry))
  201. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  202. ;;; Hide/Show
  203. (defvar foldit-hs-start-tag-end-func 'foldit-hs-default-start-tag-end)
  204. (make-variable-buffer-local 'foldit-hs-start-tag-end-func)
  205. (put 'foldit-hs-start-tag-end-func 'permanent-local t)
  206. (defun foldit-hs-default-start-tag-end (beg)
  207. "Find end of hide/show tag beginning at BEG."
  208. (min (+ beg 65)
  209. (save-excursion
  210. (goto-char beg)
  211. (line-end-position))))
  212. (defvar foldit-hs-keymap
  213. (let ((map (make-sparse-keymap)))
  214. (define-key map "\r" 'foldit-hs-show-block)
  215. (define-key map [down-mouse-1] 'foldit-hs-show-block)
  216. (define-key map [S-tab] 'mlinks-backward-link)
  217. (define-key map [tab] 'mlinks-forward-link)
  218. (define-key map "\t" 'mlinks-forward-link)
  219. map))
  220. (defvar foldit-hs-hide-again-keymap
  221. (let ((map (make-sparse-keymap)))
  222. (define-key map "\r" 'foldit-hs-hide-again)
  223. (define-key map [down-mouse-1] 'foldit-hs-hide-again)
  224. (define-key map [S-tab] 'mlinks-backward-link)
  225. (define-key map [tab] 'mlinks-forward-link)
  226. (define-key map "\t" 'mlinks-forward-link)
  227. map))
  228. (defun foldit-hs-set-up-overlay (ovl)
  229. "Set up overlay OVL for hide/show."
  230. (let* ((num-lines (count-lines (overlay-start ovl) (overlay-end ovl)))
  231. (here (point))
  232. (start-tag-beg (overlay-start ovl))
  233. (start-tag-end (funcall foldit-hs-start-tag-end-func start-tag-beg))
  234. (tag (buffer-substring start-tag-beg start-tag-end)))
  235. (goto-char here)
  236. ;;(overlay-put ovl 'isearch-open-invisible t)
  237. (overlay-put ovl 'display (concat
  238. (propertize "+" 'face 'mode-line)
  239. " "
  240. tag (foldit-hidden-line-str num-lines "h")))
  241. (overlay-put ovl 'foldit 'display)
  242. (overlay-put ovl 'keymap foldit-hs-keymap)
  243. (overlay-put ovl 'face 'next-error)
  244. (overlay-put ovl 'face 'lazy-highlight)
  245. (overlay-put ovl 'mouse-face 'highlight)
  246. (overlay-put ovl 'help-echo "Press RET to show hidden part")
  247. (overlay-put ovl 'mlinks-link t)
  248. (overlay-put ovl 'priority (foldit-overlay-priority))
  249. (mumamo-with-buffer-prepared-for-jit-lock
  250. (put-text-property start-tag-beg (+ start-tag-beg 1)
  251. 'foldit-tag-end (copy-marker start-tag-end)))))
  252. (defun foldit-hs-show-block ()
  253. "Show hidden block."
  254. (interactive)
  255. (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
  256. (hs-show-block)
  257. (mumamo-with-buffer-prepared-for-jit-lock
  258. (set-text-properties (point) (+ (point) 2) 'foldit-tag-end))
  259. (when tag-end (goto-char tag-end))
  260. (foldit-add-temp-at-point-overlay "-"
  261. foldit-hs-hide-again-keymap
  262. "Press RET to hide again")))
  263. (defun foldit-hs-hide-again ()
  264. "Hide hide/show block again."
  265. (interactive)
  266. (when (overlayp foldit-temp-at-point-ovl)
  267. (delete-overlay foldit-temp-at-point-ovl))
  268. (hs-hide-block))
  269. ;;; Fix-me: break out this
  270. ;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  271. (defun foldit-add-temp-at-point-overlay (marker keymap msg)
  272. "Add a temporary overlay with a marker MARKER and a keymap KEYMAP.
  273. The overlay is also given the help echo MSG.
  274. This overlay is removed as soon as point moves from current point."
  275. (let ((ovl (make-overlay (point) (1+ (point))))
  276. (real (buffer-substring (point) (1+ (point)))))
  277. (overlay-put ovl 'isearch-open-invisible t)
  278. (overlay-put ovl 'display (concat
  279. (propertize marker 'face 'mode-line)
  280. " "
  281. msg
  282. real))
  283. (overlay-put ovl 'foldit 'foldit)
  284. (overlay-put ovl 'keymap keymap)
  285. (overlay-put ovl 'face 'lazy-highlight)
  286. (overlay-put ovl 'mouse-face 'highlight)
  287. (overlay-put ovl 'help-echo msg)
  288. (overlay-put ovl 'mlinks-link t)
  289. (overlay-put ovl 'priority (foldit-overlay-priority))
  290. (setq foldit-temp-at-point-ovl ovl)
  291. (add-hook 'post-command-hook
  292. 'foldit-remove-temp-at-point-overlay
  293. nil t)))
  294. (defun foldit-remove-temp-at-point-overlay ()
  295. "Remove overlay made by `foldit-add-temp-at-point-overlay'."
  296. (condition-case err
  297. (unless (and foldit-temp-at-point-ovl
  298. (overlay-buffer foldit-temp-at-point-ovl)
  299. (= (overlay-start foldit-temp-at-point-ovl)
  300. (point)))
  301. (delete-overlay foldit-temp-at-point-ovl)
  302. (setq foldit-temp-at-point-ovl nil)
  303. (remove-hook 'post-command-hook 'foldit-remove-temp-at-point-overlay t)
  304. )
  305. (error (message "foldit-remove-temp-at-point-overlay: %s"
  306. (propertize (error-message-string err))))))
  307. ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  308. ;; (defun put-before-on-invis ()
  309. ;; (let* (o
  310. ;; (io (catch 'io
  311. ;; (dolist (o (overlays-at (1+ (point))))
  312. ;; (when (overlay-get o 'invisible)
  313. ;; (throw 'io o)))))
  314. ;; (str (propertize "IOSTRING"
  315. ;; 'face 'secondary-selection
  316. ;; )))
  317. ;; (overlay-put io 'before-string str)
  318. ;; ;;(overlay-put io 'display "display")
  319. ;; (overlay-put io 'display nil)
  320. ;; ;;(overlay-put io 'after-string "AFTER")
  321. ;; ))
  322. (provide 'foldit)
  323. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  324. ;;; foldit.el ends here