gutter added
|
@ -0,0 +1,334 @@
|
||||||
|
;;; fringe-helper.el --- helper functions for fringe bitmaps
|
||||||
|
;;
|
||||||
|
;; Copyright (C) 2008 Nikolaj Schumacher
|
||||||
|
;;
|
||||||
|
;; Author: Nikolaj Schumacher <bugs * nschum de>
|
||||||
|
;; Version: 0.1.1
|
||||||
|
;; Keywords: lisp
|
||||||
|
;; URL: http://nschum.de/src/emacs/fringe-helper/
|
||||||
|
;; Compatibility: GNU Emacs 22.x
|
||||||
|
;;
|
||||||
|
;; This file is NOT part of GNU Emacs.
|
||||||
|
;;
|
||||||
|
;; 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 2
|
||||||
|
;; of the License, 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. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; fringe-helper contains helper functions for fringe bitmaps.
|
||||||
|
;;
|
||||||
|
;; `fringe-helper-define' allows you to to define fringe bitmaps using a visual
|
||||||
|
;; string replesentation. For example:
|
||||||
|
;;
|
||||||
|
;; (fringe-helper-define 'test-bitmap '(top repeat)
|
||||||
|
;; "XX......"
|
||||||
|
;; "..XX...."
|
||||||
|
;; "....XX.."
|
||||||
|
;; "......XX")
|
||||||
|
;;
|
||||||
|
;; You can also generate arguments for `define-fringe-bitmap' yourself, by
|
||||||
|
;; using `fringe-helper-convert'.
|
||||||
|
;;
|
||||||
|
;; fringe-helper also provides a few stock bitmaps. They are loaded on demand
|
||||||
|
;; by `fringe-lib-load' and adapt to the current fringe size to a certain
|
||||||
|
;; extend.
|
||||||
|
;;
|
||||||
|
;; `fringe-helper-insert' inserts a fringe bitmap at point and
|
||||||
|
;; `fringe-helper-insert-region' inserts a fringe bitmap along a region.
|
||||||
|
;; `fringe-helper-remove' removes both kinds.
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; Here's an example for enhancing `flymake-mode' with fringe bitmaps:
|
||||||
|
;;
|
||||||
|
;; (require 'fringe-helper)
|
||||||
|
;; (require 'flymake)
|
||||||
|
;;
|
||||||
|
;; (defvar flymake-fringe-overlays nil)
|
||||||
|
;; (make-variable-buffer-local 'flymake-fringe-overlays)
|
||||||
|
;;
|
||||||
|
;; (defadvice flymake-make-overlay (after add-to-fringe first
|
||||||
|
;; (beg end tooltip-text face mouse-face)
|
||||||
|
;; activate compile)
|
||||||
|
;; (push (fringe-helper-insert-region
|
||||||
|
;; beg end
|
||||||
|
;; (fringe-lib-load (if (eq face 'flymake-errline)
|
||||||
|
;; fringe-lib-exclamation-mark
|
||||||
|
;; fringe-lib-question-mark))
|
||||||
|
;; 'left-fringe 'font-lock-warning-face)
|
||||||
|
;; flymake-fringe-overlays))
|
||||||
|
;;
|
||||||
|
;; (defadvice flymake-delete-own-overlays (after remove-from-fringe activate
|
||||||
|
;; compile)
|
||||||
|
;; (mapc 'fringe-helper-remove flymake-fringe-overlays)
|
||||||
|
;; (setq flymake-fringe-overlays nil))
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;;; Change Log:
|
||||||
|
;;
|
||||||
|
;; 2008-06-04 (0.1.1)
|
||||||
|
;; Fixed bug where `fringe-helper-remove' missed overlays at the end.
|
||||||
|
;; Fixed `fringe-lib-load' to work when already loaded.
|
||||||
|
;;
|
||||||
|
;; 2008-04-25 (0.1)
|
||||||
|
;; Initial release.
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(eval-when-compile (require 'cl))
|
||||||
|
|
||||||
|
(defun fringe-helper-convert (&rest strings)
|
||||||
|
"Convert STRINGS into a vector usable for `define-fringe-bitmap'.
|
||||||
|
Each string in STRINGS represents a line of the fringe bitmap.
|
||||||
|
Periods (.) are background-colored pixel; Xs are foreground-colored. The
|
||||||
|
fringe bitmap always is aligned to the right. If the fringe has half
|
||||||
|
width, only the left 4 pixels of an 8 pixel bitmap will be shown.
|
||||||
|
|
||||||
|
For example, the following code defines a diagonal line.
|
||||||
|
|
||||||
|
\(fringe-helper-convert
|
||||||
|
\"XX......\"
|
||||||
|
\"..XX....\"
|
||||||
|
\"....XX..\"
|
||||||
|
\"......XX\"\)"
|
||||||
|
(unless (cdr strings)
|
||||||
|
;; only one string, probably with newlines
|
||||||
|
(setq strings (split-string (car strings) "\n")))
|
||||||
|
(apply 'vector
|
||||||
|
(mapcar (lambda (str)
|
||||||
|
(let ((num 0))
|
||||||
|
(dolist (c (string-to-list str))
|
||||||
|
(setq num (+ (* num 2) (if (eq c ?.) 0 1))))
|
||||||
|
num))
|
||||||
|
strings)))
|
||||||
|
|
||||||
|
(defmacro fringe-helper-define (name alignment &rest strings)
|
||||||
|
"Define a fringe bitmap from a visual representation.
|
||||||
|
Parameters NAME and ALIGNMENT are the same as `define-fringe-bitmap'.
|
||||||
|
Each string in STRINGS represents a line of the fringe bitmap as in
|
||||||
|
`fringe-helper-convert'."
|
||||||
|
(declare (indent defun))
|
||||||
|
`(define-fringe-bitmap ,name
|
||||||
|
(eval-when-compile (fringe-helper-convert ,@strings))
|
||||||
|
nil nil ,alignment))
|
||||||
|
|
||||||
|
(defun fringe-helper-insert (bitmap pos &optional side face)
|
||||||
|
"Insert a fringe bitmap at POS.
|
||||||
|
BITMAP is the name of a bitmap defined with `define-fringe-bitmap' or
|
||||||
|
`fringe-helper-define'. SIDE defaults to 'left-fringe and can also be
|
||||||
|
'right-fringe. FACE is used to determine the bitmap's color.
|
||||||
|
The function returns an object suitable for passing to
|
||||||
|
`fringe-helper-remove'."
|
||||||
|
(let* ((display-string `(,(or side 'left-fringe) ,bitmap .
|
||||||
|
,(when face (cons face nil))))
|
||||||
|
(before-string (propertize "!" 'display display-string))
|
||||||
|
(ov (make-overlay pos pos)))
|
||||||
|
(overlay-put ov 'before-string before-string)
|
||||||
|
(overlay-put ov 'fringe-helper t)
|
||||||
|
ov))
|
||||||
|
|
||||||
|
(defun fringe-helper-insert-region (beg end bitmap side &optional face)
|
||||||
|
"Insert fringe bitmaps between BEG and END.
|
||||||
|
BITMAP is the name of a bitmap defined with `define-fringe-bitmap' or
|
||||||
|
`fringe-helper-define'. SIDE defaults to 'left-fringe and can also be
|
||||||
|
'right-fringe. FACE is used to determine the bitmap's color. The
|
||||||
|
function returns an overlay covering the entire region, which is suitable
|
||||||
|
for passing to `fringe-helper-remove'. The region grows and shrinks with
|
||||||
|
input automatically."
|
||||||
|
(let* ((display-string `(,(or side 'left-fringe) ,bitmap .
|
||||||
|
,(when face (cons face nil))))
|
||||||
|
(before-string (propertize "!" 'display display-string))
|
||||||
|
(parent (make-overlay beg end))
|
||||||
|
ov)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char beg)
|
||||||
|
(goto-char (point-at-bol 2))
|
||||||
|
;; can't use <= here, or we'll get an infinity loop at buffer end
|
||||||
|
(while (and (<= (point) end) (< (point) (point-max)))
|
||||||
|
(setq ov (make-overlay (point) (point)))
|
||||||
|
(overlay-put ov 'before-string before-string)
|
||||||
|
(overlay-put ov 'fringe-helper-parent parent)
|
||||||
|
(goto-char (point-at-bol 2))))
|
||||||
|
(overlay-put parent 'fringe-helper t)
|
||||||
|
(overlay-put parent 'before-string before-string)
|
||||||
|
(overlay-put parent 'insert-in-front-hooks
|
||||||
|
'(fringe-helper-modification-func))
|
||||||
|
(overlay-put parent 'modification-hooks
|
||||||
|
'(fringe-helper-modification-func))
|
||||||
|
parent))
|
||||||
|
|
||||||
|
(defun fringe-helper-modification-func (ov after-p beg end &optional len)
|
||||||
|
(if after-p
|
||||||
|
(if (eq beg end)
|
||||||
|
;; evaporate overlay
|
||||||
|
(when (= (overlay-start ov) (overlay-end ov))
|
||||||
|
(delete-overlay ov))
|
||||||
|
;; if new lines are inserted, add new bitmaps
|
||||||
|
(let ((before-string (overlay-get ov 'before-string))
|
||||||
|
fringe-ov)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char beg)
|
||||||
|
(while (search-forward "\n" end t)
|
||||||
|
(setq fringe-ov (make-overlay (point) (point)))
|
||||||
|
(overlay-put fringe-ov 'before-string before-string)
|
||||||
|
(overlay-put fringe-ov 'fringe-helper-parent ov)))))
|
||||||
|
;; if a \n is removed, remove the fringe overlay
|
||||||
|
(unless (= beg end)
|
||||||
|
(setq beg (max beg (overlay-start ov)))
|
||||||
|
(setq end (min end (overlay-end ov)))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char beg)
|
||||||
|
(while (search-forward "\n" end t)
|
||||||
|
(let ((overlays (overlays-in (point) (1+ (point)))))
|
||||||
|
(while overlays
|
||||||
|
(when (eq (overlay-get (car overlays) 'fringe-helper-parent) ov)
|
||||||
|
(delete-overlay (car overlays))
|
||||||
|
(setq overlays nil))
|
||||||
|
(pop overlays))))))))
|
||||||
|
|
||||||
|
(defun fringe-helper-remove (fringe-bitmap-reference)
|
||||||
|
"Remove a fringe bitmap."
|
||||||
|
(unless (or (not (overlay-buffer fringe-bitmap-reference))
|
||||||
|
(overlay-get fringe-bitmap-reference 'fringe-helper-parent))
|
||||||
|
;; region
|
||||||
|
(dolist (ov (overlays-in (overlay-start fringe-bitmap-reference)
|
||||||
|
(1+ (overlay-end fringe-bitmap-reference))))
|
||||||
|
(when (eq (overlay-get ov 'fringe-helper-parent) fringe-bitmap-reference)
|
||||||
|
(delete-overlay ov)))
|
||||||
|
(delete-overlay fringe-bitmap-reference)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defun fringe-lib-load (pattern &optional side)
|
||||||
|
"Load a stock bitmap.
|
||||||
|
It returns the symbol name of the loaded bitmap, which is suitable for passing
|
||||||
|
to `fringe-helper-insert'. The actual work of defining the bitmap is only done once.
|
||||||
|
PATTERN can be one of the following:
|
||||||
|
|
||||||
|
`fringe-lib-exclamation-mark': an exclamation mark
|
||||||
|
|
||||||
|
`fringe-lib-question-mark': a question mark
|
||||||
|
|
||||||
|
`fringe-lib-zig-zag': a zig-zag pattern
|
||||||
|
|
||||||
|
`fringe-lib-wave': a wavy-line pattern
|
||||||
|
|
||||||
|
`fringe-lib-stipple': a stipple pattern
|
||||||
|
|
||||||
|
`fringe-lib-full': a solid color
|
||||||
|
|
||||||
|
SIDE should be either 'left-fringe or 'right-fringe and defaults to the former."
|
||||||
|
(let ((fringe-width (frame-parameter (selected-frame)
|
||||||
|
(or side 'left-fringe)))
|
||||||
|
(alignment (when (eq (car pattern) 'repeat)
|
||||||
|
(setq pattern (cdr pattern))
|
||||||
|
'(top t))))
|
||||||
|
(while (> (caar pattern) fringe-width)
|
||||||
|
(pop pattern))
|
||||||
|
(setq pattern (cdar pattern))
|
||||||
|
(or (car (memq (car pattern) fringe-bitmaps))
|
||||||
|
(define-fringe-bitmap (car pattern) (cdr pattern) nil nil alignment))))
|
||||||
|
|
||||||
|
|
||||||
|
(defconst fringe-lib-exclamation-mark
|
||||||
|
`((5 fringe-lib-exclamation-mark-5 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert "...XX..."
|
||||||
|
"..XXXX.."
|
||||||
|
"..XXXX.."
|
||||||
|
"...XX..."
|
||||||
|
"...XX..."
|
||||||
|
"........"
|
||||||
|
"........"
|
||||||
|
"...XX..."
|
||||||
|
"...XX...")))
|
||||||
|
(0 fringe-lib-exclamation-mark-0 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert ".XX....."
|
||||||
|
".XX....."
|
||||||
|
".XX....."
|
||||||
|
".XX....."
|
||||||
|
".XX....."
|
||||||
|
"........"
|
||||||
|
"........"
|
||||||
|
".XX....."
|
||||||
|
".XX.....")))))
|
||||||
|
|
||||||
|
(defconst fringe-lib-question-mark
|
||||||
|
`((5 fringe-lib-question-mark-5 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert "...XX..."
|
||||||
|
"..XXXX.."
|
||||||
|
"..X..X.."
|
||||||
|
"....XX.."
|
||||||
|
"...XX..."
|
||||||
|
"...XX..."
|
||||||
|
"........"
|
||||||
|
"...XX..."
|
||||||
|
"...XX...")))
|
||||||
|
(0 fringe-lib-question-mark-0 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert ".XX....."
|
||||||
|
"XXXX...."
|
||||||
|
"X..X...."
|
||||||
|
"..XX...."
|
||||||
|
".XX....."
|
||||||
|
".XX....."
|
||||||
|
"........"
|
||||||
|
".XX....."
|
||||||
|
".XX.....")))))
|
||||||
|
|
||||||
|
(defconst fringe-lib-zig-zag
|
||||||
|
`(repeat
|
||||||
|
(0 fringe-lib-zig-zag-0 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert "X......."
|
||||||
|
"X......."
|
||||||
|
".X......"
|
||||||
|
".X......"
|
||||||
|
"..X....."
|
||||||
|
"..X....."
|
||||||
|
".X......"
|
||||||
|
".X......")))))
|
||||||
|
|
||||||
|
(defconst fringe-lib-wave
|
||||||
|
`(repeat
|
||||||
|
(0 fringe-lib-wave-0 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert "X......."
|
||||||
|
".X......"
|
||||||
|
"..X....."
|
||||||
|
"..X....."
|
||||||
|
"..X....."
|
||||||
|
".X......"
|
||||||
|
"X......."
|
||||||
|
"X.......")))))
|
||||||
|
|
||||||
|
(defconst fringe-lib-stipple
|
||||||
|
`(repeat
|
||||||
|
(0 fringe-lib-stipple-0 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert "XXXXXXXX"
|
||||||
|
"XXXXXXXX"
|
||||||
|
"XXXXXXXX"
|
||||||
|
"........"
|
||||||
|
"........"
|
||||||
|
"........")))))
|
||||||
|
|
||||||
|
(defconst fringe-lib-full
|
||||||
|
`(repeat
|
||||||
|
(0 fringe-lib-full-0 .
|
||||||
|
,(eval-when-compile
|
||||||
|
(fringe-helper-convert "XXXXXXXX")))))
|
||||||
|
|
||||||
|
(provide 'fringe-helper)
|
||||||
|
;;; fringe-helper.el ends here
|
|
@ -0,0 +1,134 @@
|
||||||
|
;;; git-gutter-fringe.el --- Fringe version of git-gutter.el
|
||||||
|
|
||||||
|
;; Copyright (C) 2013 by Syohei YOSHIDA
|
||||||
|
|
||||||
|
;; Author: Syohei YOSHIDA <syohex@gmail.com>
|
||||||
|
;; URL: https://github.com/syohex/emacs-git-gutter-fringe
|
||||||
|
;; Version: 0.02
|
||||||
|
;; Package-Requires: ((git-gutter "0.16") (fringe-helper "0.1.1"))
|
||||||
|
|
||||||
|
;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(eval-when-compile
|
||||||
|
(require 'cl))
|
||||||
|
|
||||||
|
(require 'git-gutter)
|
||||||
|
(require 'fringe-helper)
|
||||||
|
|
||||||
|
(defface git-gutter-fr:modified
|
||||||
|
'((t (:foreground "magenta" :weight bold)))
|
||||||
|
"Face of modified"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defface git-gutter-fr:added
|
||||||
|
'((t (:foreground "green" :weight bold)))
|
||||||
|
"Face of added"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defface git-gutter-fr:deleted
|
||||||
|
'((t (:foreground "red" :weight bold)))
|
||||||
|
"Face of deleted"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter-fr:side 'left-fringe
|
||||||
|
"Side of show diff information"
|
||||||
|
:type '(choice (const :tag "Right Fringe" right-fringe)
|
||||||
|
(const :tag "Left Fringe" left-fringe))
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(fringe-helper-define 'git-gutter-fr:added nil
|
||||||
|
"...XX..."
|
||||||
|
"...XX..."
|
||||||
|
"...XX..."
|
||||||
|
"XXXXXXXX"
|
||||||
|
"XXXXXXXX"
|
||||||
|
"...XX..."
|
||||||
|
"...XX..."
|
||||||
|
"...XX...")
|
||||||
|
|
||||||
|
(fringe-helper-define 'git-gutter-fr:deleted nil
|
||||||
|
"........"
|
||||||
|
"........"
|
||||||
|
"........"
|
||||||
|
"XXXXXXXX"
|
||||||
|
"XXXXXXXX"
|
||||||
|
"........"
|
||||||
|
"........"
|
||||||
|
"........")
|
||||||
|
|
||||||
|
(fringe-helper-define 'git-gutter-fr:modified nil
|
||||||
|
"........"
|
||||||
|
"..XXXX.."
|
||||||
|
"..XXXX.."
|
||||||
|
"..XXXX.."
|
||||||
|
"..XXXX.."
|
||||||
|
"..XXXX.."
|
||||||
|
"..XXXX.."
|
||||||
|
"........")
|
||||||
|
|
||||||
|
(defun git-gutter-fr:select-sign (type)
|
||||||
|
(case type
|
||||||
|
(modified 'git-gutter-fr:modified)
|
||||||
|
(added 'git-gutter-fr:added)
|
||||||
|
(deleted 'git-gutter-fr:deleted)
|
||||||
|
(otherwise
|
||||||
|
(error "Invalid type"))))
|
||||||
|
|
||||||
|
(defun git-gutter-fr:select-face (type)
|
||||||
|
(case type
|
||||||
|
(modified 'git-gutter-fr:modified)
|
||||||
|
(added 'git-gutter-fr:added)
|
||||||
|
(deleted 'git-gutter-fr:deleted)
|
||||||
|
(otherwise
|
||||||
|
(error "Invalid type"))))
|
||||||
|
|
||||||
|
(defvar git-gutter-fr:bitmap-references nil)
|
||||||
|
(make-variable-buffer-local 'git-gutter-fr:bitmap-references)
|
||||||
|
|
||||||
|
(defun git-gutter-fr:view-region (type start-line end-line)
|
||||||
|
(let* ((sign (git-gutter-fr:select-sign type))
|
||||||
|
(face (git-gutter-fr:select-face type))
|
||||||
|
(beg (git-gutter:line-to-pos start-line))
|
||||||
|
(end (or (and end-line (git-gutter:line-to-pos end-line))
|
||||||
|
beg))
|
||||||
|
(reference (fringe-helper-insert-region
|
||||||
|
beg end sign git-gutter-fr:side face)))
|
||||||
|
(push reference git-gutter-fr:bitmap-references)))
|
||||||
|
|
||||||
|
(defun git-gutter-fr:view-diff-info (diffinfo)
|
||||||
|
(let ((start-line (plist-get diffinfo :start-line))
|
||||||
|
(end-line (plist-get diffinfo :end-line))
|
||||||
|
(type (plist-get diffinfo :type)))
|
||||||
|
(git-gutter-fr:view-region type start-line end-line)))
|
||||||
|
|
||||||
|
(defun git-gutter-fr:view-diff-infos (diffinfos)
|
||||||
|
(when git-gutter-fr:bitmap-references
|
||||||
|
(git-gutter:clear))
|
||||||
|
(save-excursion
|
||||||
|
(mapc #'git-gutter-fr:view-diff-info diffinfos)))
|
||||||
|
|
||||||
|
(defun git-gutter-fr:clear ()
|
||||||
|
(mapc 'fringe-helper-remove git-gutter-fr:bitmap-references)
|
||||||
|
(setq git-gutter-fr:bitmap-references nil))
|
||||||
|
|
||||||
|
(setq git-gutter:view-diff-function #'git-gutter-fr:view-diff-infos)
|
||||||
|
(setq git-gutter:clear-function #'git-gutter-fr:clear)
|
||||||
|
|
||||||
|
(provide 'git-gutter-fringe)
|
||||||
|
|
||||||
|
;;; git-gutter-fringe.el ends here
|
|
@ -0,0 +1,351 @@
|
||||||
|
;;; git-gutter.el --- Port of Sublime Text 2 plugin GitGutter
|
||||||
|
|
||||||
|
;; Copyright (C) 2013 by Syohei YOSHIDA
|
||||||
|
|
||||||
|
;; Author: Syohei YOSHIDA <syohex@gmail.com>
|
||||||
|
;; URL: https://github.com/syohex/emacs-git-gutter
|
||||||
|
;; Version: 0.19
|
||||||
|
|
||||||
|
;; 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; Port of GitGutter which is a plugin of Sublime Text2
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(eval-when-compile
|
||||||
|
(require 'cl))
|
||||||
|
|
||||||
|
(defgroup git-gutter nil
|
||||||
|
"Port GitGutter"
|
||||||
|
:prefix "git-gutter:"
|
||||||
|
:group 'vc)
|
||||||
|
|
||||||
|
(defcustom git-gutter:window-width nil
|
||||||
|
"Character width of gutter window. Emacs mistakes width of some characters.
|
||||||
|
It is better to explicitly assign width to this variable, if you use full-width
|
||||||
|
character for signs of changes"
|
||||||
|
:type 'integer
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:diff-option ""
|
||||||
|
"Option of 'git diff'"
|
||||||
|
:type 'string
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:modified-sign "="
|
||||||
|
"Modified sign"
|
||||||
|
:type 'string
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:added-sign "+"
|
||||||
|
"Added sign"
|
||||||
|
:type 'string
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:deleted-sign "-"
|
||||||
|
"Deleted sign"
|
||||||
|
:type 'string
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:unchanged-sign nil
|
||||||
|
"Deleted sign"
|
||||||
|
:type 'string
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:always-show-gutter nil
|
||||||
|
"Always show gutter"
|
||||||
|
:type 'boolean
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defcustom git-gutter:lighter " GitGutter"
|
||||||
|
"Minor mode lighter in mode-line"
|
||||||
|
:type 'string
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defface git-gutter:modified
|
||||||
|
'((t (:foreground "magenta" :weight bold)))
|
||||||
|
"Face of modified"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defface git-gutter:added
|
||||||
|
'((t (:foreground "green" :weight bold)))
|
||||||
|
"Face of added"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defface git-gutter:deleted
|
||||||
|
'((t (:foreground "red" :weight bold)))
|
||||||
|
"Face of deleted"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defface git-gutter:unchanged
|
||||||
|
'((t (:background "yellow")))
|
||||||
|
"Face of unchanged"
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(defvar git-gutter:view-diff-function #'git-gutter:view-diff-infos
|
||||||
|
"Function of viewing changes")
|
||||||
|
|
||||||
|
(defvar git-gutter:clear-function #'git-gutter:clear-overlays
|
||||||
|
"Function of clear changes")
|
||||||
|
|
||||||
|
(defvar git-gutter:enabled nil)
|
||||||
|
(defvar git-gutter:overlays nil)
|
||||||
|
(defvar git-gutter:diffinfos nil)
|
||||||
|
|
||||||
|
(defun git-gutter:in-git-repository-p ()
|
||||||
|
(with-temp-buffer
|
||||||
|
(let ((cmd "git rev-parse --is-inside-work-tree"))
|
||||||
|
(when (zerop (call-process-shell-command cmd nil t))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(string= "true" (buffer-substring-no-properties
|
||||||
|
(point) (line-end-position)))))))
|
||||||
|
|
||||||
|
(defun git-gutter:root-directory ()
|
||||||
|
(with-temp-buffer
|
||||||
|
(let* ((cmd "git rev-parse --show-toplevel")
|
||||||
|
(ret (call-process-shell-command cmd nil t)))
|
||||||
|
(unless (zerop ret)
|
||||||
|
(error "Here is not git repository!!"))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(let ((root (buffer-substring-no-properties (point) (line-end-position))))
|
||||||
|
(when (string= root "")
|
||||||
|
(error "You maybe be in '.git/' directory"))
|
||||||
|
(file-name-as-directory root)))))
|
||||||
|
|
||||||
|
(defun git-gutter:changes-to-number (str)
|
||||||
|
(if (string= str "")
|
||||||
|
1
|
||||||
|
(string-to-number str)))
|
||||||
|
|
||||||
|
(defun git-gutter:make-diffinfo (type start &optional end)
|
||||||
|
(list :type type :start-line start :end-line end))
|
||||||
|
|
||||||
|
(defun git-gutter:diff (curfile)
|
||||||
|
(let ((cmd (format "git diff --no-ext-diff -U0 %s %s" git-gutter:diff-option curfile))
|
||||||
|
(regexp "^@@ -\\([0-9]+\\),?\\([0-9]*\\) \\+\\([0-9]+\\),?\\([0-9]*\\) @@"))
|
||||||
|
(with-temp-buffer
|
||||||
|
(let ((ret (call-process-shell-command cmd nil t)))
|
||||||
|
(unless (or (zerop ret))
|
||||||
|
(error (format "Failed '%s'" cmd))))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(loop while (re-search-forward regexp nil t)
|
||||||
|
for orig-line = (string-to-number (match-string 1))
|
||||||
|
for new-line = (string-to-number (match-string 3))
|
||||||
|
for orig-changes = (git-gutter:changes-to-number (match-string 2))
|
||||||
|
for new-changes = (git-gutter:changes-to-number (match-string 4))
|
||||||
|
for end-line = (1- (+ new-line new-changes))
|
||||||
|
collect
|
||||||
|
(cond ((zerop orig-changes)
|
||||||
|
(git-gutter:make-diffinfo 'added new-line end-line))
|
||||||
|
((zerop new-changes)
|
||||||
|
(git-gutter:make-diffinfo 'deleted (1- orig-line)))
|
||||||
|
(t
|
||||||
|
(git-gutter:make-diffinfo 'modified new-line end-line)))))))
|
||||||
|
|
||||||
|
(defun git-gutter:line-to-pos (line)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(forward-line (1- line))
|
||||||
|
(point)))
|
||||||
|
|
||||||
|
(defmacro git-gutter:before-string (sign)
|
||||||
|
`(propertize " " 'display `((margin left-margin) ,sign)))
|
||||||
|
|
||||||
|
(defun git-gutter:select-face (type)
|
||||||
|
(case type
|
||||||
|
(added 'git-gutter:added)
|
||||||
|
(modified 'git-gutter:modified)
|
||||||
|
(deleted 'git-gutter:deleted)))
|
||||||
|
|
||||||
|
(defun git-gutter:select-sign (type)
|
||||||
|
(case type
|
||||||
|
(added git-gutter:added-sign)
|
||||||
|
(modified git-gutter:modified-sign)
|
||||||
|
(deleted git-gutter:deleted-sign)))
|
||||||
|
|
||||||
|
(defun git-gutter:propertized-sign (type)
|
||||||
|
(let ((sign (git-gutter:select-sign type))
|
||||||
|
(face (git-gutter:select-face type)))
|
||||||
|
(propertize sign 'face face)))
|
||||||
|
|
||||||
|
(defun git-gutter:view-region (sign start-line end-line)
|
||||||
|
(let ((beg (git-gutter:line-to-pos start-line)))
|
||||||
|
(goto-char beg)
|
||||||
|
(while (and (<= (line-number-at-pos) end-line) (not (eobp)))
|
||||||
|
(git-gutter:view-at-pos sign (point))
|
||||||
|
(forward-line 1))))
|
||||||
|
|
||||||
|
(defun git-gutter:view-at-pos (sign pos)
|
||||||
|
(let ((ov (make-overlay pos pos)))
|
||||||
|
(overlay-put ov 'before-string (git-gutter:before-string sign))
|
||||||
|
(push ov git-gutter:overlays)))
|
||||||
|
|
||||||
|
(defun git-gutter:view-diff-info (diffinfo)
|
||||||
|
(let* ((start-line (plist-get diffinfo :start-line))
|
||||||
|
(end-line (plist-get diffinfo :end-line))
|
||||||
|
(type (plist-get diffinfo :type))
|
||||||
|
(sign (git-gutter:propertized-sign type)))
|
||||||
|
(case type
|
||||||
|
((modified added) (git-gutter:view-region sign start-line end-line))
|
||||||
|
(deleted (git-gutter:view-at-pos
|
||||||
|
sign (git-gutter:line-to-pos start-line))))))
|
||||||
|
|
||||||
|
(defun git-gutter:sign-width (sign)
|
||||||
|
(loop for s across sign
|
||||||
|
sum (char-width s)))
|
||||||
|
|
||||||
|
(defun git-gutter:longest-sign-width ()
|
||||||
|
(let ((signs (list git-gutter:modified-sign
|
||||||
|
git-gutter:added-sign
|
||||||
|
git-gutter:deleted-sign)))
|
||||||
|
(when git-gutter:unchanged-sign
|
||||||
|
(add-to-list 'signs git-gutter:unchanged-sign))
|
||||||
|
(apply #'max (mapcar #'git-gutter:sign-width signs))))
|
||||||
|
|
||||||
|
(defun git-gutter:view-for-unchanged ()
|
||||||
|
(save-excursion
|
||||||
|
(let ((sign (propertize git-gutter:unchanged-sign
|
||||||
|
'face 'git-gutter:unchanged)))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (not (eobp))
|
||||||
|
(git-gutter:view-at-pos sign (point))
|
||||||
|
(forward-line 1)))))
|
||||||
|
|
||||||
|
(defun git-gutter:view-diff-infos (diffinfos)
|
||||||
|
(let ((curwin (get-buffer-window))
|
||||||
|
(win-width (or git-gutter:window-width
|
||||||
|
(git-gutter:longest-sign-width))))
|
||||||
|
(when git-gutter:unchanged-sign
|
||||||
|
(git-gutter:view-for-unchanged))
|
||||||
|
(when diffinfos
|
||||||
|
(save-excursion
|
||||||
|
(mapc #'git-gutter:view-diff-info diffinfos)))
|
||||||
|
(when (or git-gutter:always-show-gutter diffinfos git-gutter:unchanged-sign)
|
||||||
|
(set-window-margins curwin win-width (cdr (window-margins curwin))))))
|
||||||
|
|
||||||
|
(defun git-gutter:delete-overlay ()
|
||||||
|
(mapc #'delete-overlay git-gutter:overlays)
|
||||||
|
(setq git-gutter:overlays nil)
|
||||||
|
(let ((curwin (get-buffer-window)))
|
||||||
|
(set-window-margins curwin 0 (cdr (window-margins curwin)))))
|
||||||
|
|
||||||
|
(defun git-gutter:process-diff (curfile)
|
||||||
|
(let ((diffinfos (git-gutter:diff curfile)))
|
||||||
|
(setq git-gutter:diffinfos diffinfos)
|
||||||
|
(funcall git-gutter:view-diff-function diffinfos)))
|
||||||
|
|
||||||
|
(defun git-gutter:clear-overlays ()
|
||||||
|
(git-gutter:delete-overlay))
|
||||||
|
|
||||||
|
(defun git-gutter:search-near-diff-index (diffinfos is-reverse)
|
||||||
|
(loop with current-line = (line-number-at-pos)
|
||||||
|
with cmp-fn = (if is-reverse '> '<)
|
||||||
|
for diffinfo in (if is-reverse (reverse diffinfos) diffinfos)
|
||||||
|
for index = 0 then (1+ index)
|
||||||
|
for start-line = (plist-get diffinfo :start-line)
|
||||||
|
when (funcall cmp-fn current-line start-line)
|
||||||
|
return (if is-reverse
|
||||||
|
(1- (- (length diffinfos) index))
|
||||||
|
index)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun git-gutter:next-diff (arg)
|
||||||
|
(interactive "p")
|
||||||
|
(when git-gutter:diffinfos
|
||||||
|
(let* ((is-reverse (< arg 0))
|
||||||
|
(diffinfos git-gutter:diffinfos)
|
||||||
|
(len (length diffinfos))
|
||||||
|
(index (git-gutter:search-near-diff-index diffinfos is-reverse))
|
||||||
|
(real-index (if index
|
||||||
|
(let ((next (if is-reverse (1+ index) (1- index))))
|
||||||
|
(mod (+ arg next) len))
|
||||||
|
(if is-reverse (1- (length diffinfos)) 0)))
|
||||||
|
(diffinfo (nth real-index diffinfos)))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(forward-line (1- (plist-get diffinfo :start-line))))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun git-gutter:previous-diff (arg)
|
||||||
|
(interactive "p")
|
||||||
|
(git-gutter:next-diff (- arg)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun git-gutter ()
|
||||||
|
(interactive)
|
||||||
|
(git-gutter:delete-overlay)
|
||||||
|
(let ((file (buffer-file-name)))
|
||||||
|
(when (and file (file-exists-p file))
|
||||||
|
(let* ((gitroot (git-gutter:root-directory))
|
||||||
|
(default-directory gitroot)
|
||||||
|
(current-file (file-relative-name file gitroot)))
|
||||||
|
(git-gutter:process-diff current-file)
|
||||||
|
(setq git-gutter:enabled t)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun git-gutter:clear ()
|
||||||
|
(interactive)
|
||||||
|
(funcall git-gutter:clear-function)
|
||||||
|
(setq git-gutter:enabled nil))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun git-gutter:toggle ()
|
||||||
|
(interactive)
|
||||||
|
(if git-gutter:enabled
|
||||||
|
(git-gutter:clear)
|
||||||
|
(git-gutter)))
|
||||||
|
|
||||||
|
(defun git-gutter:check-file-and-directory ()
|
||||||
|
(and (buffer-file-name)
|
||||||
|
default-directory (file-directory-p default-directory)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode git-gutter-mode ()
|
||||||
|
"Git-Gutter mode"
|
||||||
|
:group 'git-gutter
|
||||||
|
:init-value nil
|
||||||
|
:global nil
|
||||||
|
:lighter git-gutter:lighter
|
||||||
|
(if git-gutter-mode
|
||||||
|
(if (and (git-gutter:check-file-and-directory)
|
||||||
|
(git-gutter:in-git-repository-p))
|
||||||
|
(progn
|
||||||
|
(make-local-variable 'git-gutter:overlays)
|
||||||
|
(make-local-variable 'git-gutter:enabled)
|
||||||
|
(make-local-variable 'git-gutter:diffinfos)
|
||||||
|
(add-hook 'after-save-hook 'git-gutter nil t)
|
||||||
|
(add-hook 'after-revert-hook 'git-gutter nil t)
|
||||||
|
(add-hook 'change-major-mode-hook 'git-gutter nil t)
|
||||||
|
(add-hook 'window-configuration-change-hook 'git-gutter nil t)
|
||||||
|
(run-with-idle-timer 0 nil 'git-gutter))
|
||||||
|
(message "Here is not Git work tree")
|
||||||
|
(git-gutter-mode -1))
|
||||||
|
(remove-hook 'after-save-hook 'git-gutter t)
|
||||||
|
(remove-hook 'after-revert-hook 'git-gutter t)
|
||||||
|
(remove-hook 'change-major-mode-hook 'git-gutter t)
|
||||||
|
(remove-hook 'window-configuration-change-hook 'git-gutter t)
|
||||||
|
(git-gutter:clear)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-global-minor-mode global-git-gutter-mode
|
||||||
|
git-gutter-mode
|
||||||
|
(lambda ()
|
||||||
|
(when (and (not (minibufferp)) (buffer-file-name))
|
||||||
|
(git-gutter-mode 1)))
|
||||||
|
:group 'git-gutter)
|
||||||
|
|
||||||
|
(provide 'git-gutter)
|
||||||
|
|
||||||
|
;;; git-gutter.el ends here
|
|
@ -0,0 +1,230 @@
|
||||||
|
;;; hideshowvis.el --- Add markers to the fringe for regions foldable by hideshow.el
|
||||||
|
;;
|
||||||
|
;; Copyright 2008-2012 Jan Rehders
|
||||||
|
;;
|
||||||
|
;; Author: Jan Rehders <cmdkeen@gmx.de>
|
||||||
|
;; Version: 0.5
|
||||||
|
;; Contributions and bug fixes by Bryan Waite, Michael Heerdegen, John Yates and
|
||||||
|
;; Matthew Fidler.
|
||||||
|
;;
|
||||||
|
;; This file 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 2, or (at your option)
|
||||||
|
;; any later version.
|
||||||
|
;;
|
||||||
|
;; This file 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 GNU Emacs; see the file COPYING. If not, write to
|
||||||
|
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||||
|
;; Boston, MA 02111-1307, USA.
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; This minor mode will add little +/- displays to foldable regions in the
|
||||||
|
;; buffer and to folded regions. It is indented to be used in conjunction with
|
||||||
|
;; hideshow.el which is a part of GNU Emacs since version 20.
|
||||||
|
;;
|
||||||
|
;; Currently it works for me but is not tested heavily. Please report any bugs
|
||||||
|
;; to the above email address
|
||||||
|
;;
|
||||||
|
;;; Installation:
|
||||||
|
;; Add the following to your .emacs:
|
||||||
|
;;
|
||||||
|
;; (autoload 'hideshowvis-enable "hideshowvis" "Highlight foldable regions")
|
||||||
|
;;
|
||||||
|
;; (autoload 'hideshowvis-minor-mode
|
||||||
|
;; "hideshowvis"
|
||||||
|
;; "Will indicate regions foldable with hideshow in the fringe."
|
||||||
|
;; 'interactive)
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; (dolist (hook (list 'emacs-lisp-mode-hook
|
||||||
|
;; 'c++-mode-hook))
|
||||||
|
;; (add-hook hook 'hideshowvis-enable))
|
||||||
|
;;
|
||||||
|
;; If enabling hideshowvis-minor-mode is slow on your machine use M-x,
|
||||||
|
;; customize-option, hideshowvis-ignore-same-line and set it to nil. This will
|
||||||
|
;; then display - icons for foldable regions of one line, too but is faster
|
||||||
|
;;
|
||||||
|
;; To enable displaying a + symbol in the fringe for folded regions,
|
||||||
|
;; use:
|
||||||
|
;;
|
||||||
|
;; (hideshowvis-symbols)
|
||||||
|
;;
|
||||||
|
;; in your ~/.emacs
|
||||||
|
;;
|
||||||
|
;; It is not enabled by default because it might interfere with custom
|
||||||
|
;; hs-set-up-overlay functions
|
||||||
|
;;
|
||||||
|
;;; Changelog
|
||||||
|
;;
|
||||||
|
;; v0.5, 2012-09-11
|
||||||
|
;; - Made ELPA compliant and added function `hideshowvis-symbols'
|
||||||
|
;;
|
||||||
|
;; v0.4, 2012-03-13
|
||||||
|
;; - fixed bug causing transpose-words to be broken as well as causing problems
|
||||||
|
;; when auto-fill-mode was enabled
|
||||||
|
;;
|
||||||
|
;; v0.3, 2010-08-26
|
||||||
|
;; - added autoload cookies
|
||||||
|
;; - fixed bug causing major mode menu to disappear, among other things
|
||||||
|
;;
|
||||||
|
;; v0.2, 2009-08-09
|
||||||
|
;; - '-' symbol in fringe is clickable
|
||||||
|
;; - don't show '-' in fringe if the foldable region ends on the same line
|
||||||
|
;;
|
||||||
|
|
||||||
|
(define-fringe-bitmap 'hideshowvis-hideable-marker [0 0 0 126 126 0 0 0])
|
||||||
|
|
||||||
|
(defconst hideshowvis-version "v0.5" "Version of hideshowvis minor mode")
|
||||||
|
|
||||||
|
(defface hideshowvis-hidable-face
|
||||||
|
'((t (:foreground "#ccc" :box t)))
|
||||||
|
"Face to highlight foldable regions"
|
||||||
|
:group 'hideshow)
|
||||||
|
|
||||||
|
(defcustom hideshowvis-ignore-same-line t
|
||||||
|
"Do not display foldable regions in the fringe if the matching
|
||||||
|
closing parenthesis is on the same line. Set this to nil if
|
||||||
|
enabling the minor mode is slow on your machine"
|
||||||
|
:group 'hideshow)
|
||||||
|
|
||||||
|
(defun hideshowvis-highlight-hs-regions-in-fringe (&optional start end old-text-length)
|
||||||
|
(when hs-minor-mode
|
||||||
|
(save-excursion
|
||||||
|
(save-restriction
|
||||||
|
(when (and start end)
|
||||||
|
(narrow-to-region start end))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(remove-overlays (point-min) (point-max) 'hideshowvis-hs t)
|
||||||
|
(while (search-forward-regexp hs-block-start-regexp nil t)
|
||||||
|
(let* ((ovl (make-overlay (match-beginning 0) (match-end 0)))
|
||||||
|
(marker-string "*hideshowvis*")
|
||||||
|
(doit
|
||||||
|
(if hideshowvis-ignore-same-line
|
||||||
|
(let (begin-line)
|
||||||
|
(setq begin-line
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (match-beginning 0))
|
||||||
|
(line-number-at-pos (point))))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (match-beginning 0))
|
||||||
|
(ignore-errors
|
||||||
|
(progn
|
||||||
|
(funcall hs-forward-sexp-func 1)
|
||||||
|
(> (line-number-at-pos (point)) begin-line)))))
|
||||||
|
t)))
|
||||||
|
(when doit
|
||||||
|
(put-text-property 0
|
||||||
|
(length marker-string)
|
||||||
|
'display
|
||||||
|
(list 'left-fringe
|
||||||
|
'hideshowvis-hideable-marker
|
||||||
|
'hideshowvis-hidable-face)
|
||||||
|
marker-string)
|
||||||
|
(overlay-put ovl 'before-string marker-string)
|
||||||
|
(overlay-put ovl 'hideshowvis-hs t))))))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun hideshowvis-click-fringe (event)
|
||||||
|
(interactive "e")
|
||||||
|
(mouse-set-point event)
|
||||||
|
(end-of-line)
|
||||||
|
(if (save-excursion
|
||||||
|
(end-of-line 1)
|
||||||
|
(or (hs-already-hidden-p)
|
||||||
|
(progn
|
||||||
|
(forward-char 1)
|
||||||
|
(hs-already-hidden-p))))
|
||||||
|
(hs-show-block)
|
||||||
|
(hs-hide-block)
|
||||||
|
(beginning-of-line)))
|
||||||
|
|
||||||
|
(defvar hideshowvis-mode-map
|
||||||
|
(let ((hideshowvis-mode-map (make-sparse-keymap)))
|
||||||
|
(define-key hideshowvis-mode-map [left-fringe mouse-1]
|
||||||
|
'hideshowvis-click-fringe)
|
||||||
|
hideshowvis-mode-map)
|
||||||
|
"Keymap for hideshowvis mode")
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode hideshowvis-minor-mode ()
|
||||||
|
"Will indicate regions foldable with hideshow in the fringe."
|
||||||
|
:init-value nil
|
||||||
|
:require 'hideshow
|
||||||
|
:group 'hideshow
|
||||||
|
:keymap hideshowvis-mode-map
|
||||||
|
(condition-case nil
|
||||||
|
(if hideshowvis-minor-mode
|
||||||
|
(progn
|
||||||
|
(hs-minor-mode 1)
|
||||||
|
(hideshowvis-highlight-hs-regions-in-fringe (point-min) (point-max) 0)
|
||||||
|
(add-to-list 'after-change-functions
|
||||||
|
'hideshowvis-highlight-hs-regions-in-fringe))
|
||||||
|
(remove-overlays (point-min) (point-max) 'hideshowvis-hs t)
|
||||||
|
(setq after-change-functions
|
||||||
|
(remove 'hideshowvis-highlight-hs-regions-in-fringe
|
||||||
|
after-change-functions)))
|
||||||
|
(error
|
||||||
|
(message "Failed to toggle hideshowvis-minor-mode")
|
||||||
|
)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun hideshowvis-enable ()
|
||||||
|
"Will enable hideshowvis minor mode"
|
||||||
|
(interactive)
|
||||||
|
(hideshowvis-minor-mode 1))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun hideshowvis-symbols ()
|
||||||
|
"Defines the things necessary to get a + symbol in the fringe
|
||||||
|
and a yellow marker indicating the number of hidden lines at
|
||||||
|
the end of the line for hidden regions."
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(define-fringe-bitmap 'hs-marker [0 24 24 126 126 24 24 0])
|
||||||
|
|
||||||
|
(defcustom hs-fringe-face 'hs-fringe-face
|
||||||
|
"*Specify face used to highlight the fringe on hidden regions."
|
||||||
|
:type 'face
|
||||||
|
:group 'hideshow)
|
||||||
|
|
||||||
|
(defface hs-fringe-face
|
||||||
|
'((t (:foreground "#888" :box (:line-width 2 :color "grey75" :style released-button))))
|
||||||
|
"Face used to highlight the fringe on folded regions"
|
||||||
|
:group 'hideshow)
|
||||||
|
|
||||||
|
(defcustom hs-face 'hs-face
|
||||||
|
"*Specify the face to to use for the hidden region indicator"
|
||||||
|
:type 'face
|
||||||
|
:group 'hideshow)
|
||||||
|
|
||||||
|
(defface hs-face
|
||||||
|
'((t (:background "#ff8" :box t)))
|
||||||
|
"Face to hightlight the ... area of hidden regions"
|
||||||
|
:group 'hideshow)
|
||||||
|
|
||||||
|
(defun display-code-line-counts (ov)
|
||||||
|
(when (eq 'code (overlay-get ov 'hs))
|
||||||
|
(let* ((marker-string "*fringe-dummy*")
|
||||||
|
(marker-length (length marker-string))
|
||||||
|
(display-string (format "(%d)..." (count-lines (overlay-start ov) (overlay-end ov))))
|
||||||
|
)
|
||||||
|
(overlay-put ov 'help-echo "Hiddent text. C-c,= to show")
|
||||||
|
(put-text-property 0 marker-length 'display (list 'left-fringe 'hs-marker 'hs-fringe-face) marker-string)
|
||||||
|
(overlay-put ov 'before-string marker-string)
|
||||||
|
(put-text-property 0 (length display-string) 'face 'hs-face display-string)
|
||||||
|
(overlay-put ov 'display display-string)
|
||||||
|
)))
|
||||||
|
|
||||||
|
(setq hs-set-up-overlay 'display-code-line-counts))
|
||||||
|
|
||||||
|
(provide 'hideshowvis)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;; hideshowvis.el ends here
|
After Width: | Height: | Size: 49 KiB |
After Width: | Height: | Size: 28 KiB |
After Width: | Height: | Size: 25 KiB |
After Width: | Height: | Size: 48 KiB |
After Width: | Height: | Size: 33 KiB |
After Width: | Height: | Size: 22 KiB |
After Width: | Height: | Size: 34 KiB |