Download
(declare-function dired-previous-line "dired")
(declare-function dired-next-line "dired")
(defgroup scroll-screen nil
"scroll screen half down or up."
:prefix "scroll-screen"
:group 'scrolling)
(defcustom joseph-scroll-half-screen-up-hook nil
""
:type 'hook)
(defcustom joseph-scroll-half-screen-down-hook nil
""
:type 'hook)
(defcustom joseph-scroll-screen-line-num 5
"after scroll ,point will be keeped on this line of screen"
:group 'scroll-screen
:type 'number)
(defcustom joseph-scroll-highlight-delay 0.3
"*How long to highlight the tag.
(borrowed from etags-select.el)"
:group 'scroll-screen
:type 'number)
(defface joseph-scroll-highlight-line-face
'((t (:background "cadetblue4" :foreground "white" :weight bold)))
"Font Lock mode face used to highlight tags.
(borrowed from etags-select.el)"
:group 'scroll-screen)
(defun joseph-scroll-highlight (beg end)
"Highlight a region temporarily.
(borrowed from etags-select.el)"
(if (featurep 'xemacs)
(let ((extent (make-extent beg end)))
(set-extent-property extent 'face 'joseph-scroll-highlight-line-face)
(sit-for joseph-scroll-highlight-delay)
(delete-extent extent))
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face 'joseph-scroll-highlight-line-face)
(sit-for joseph-scroll-highlight-delay)
(delete-overlay ov))))
(defvar joseph-scroll-screen-previous-point (point-marker))
(defun joseph-scroll-half-screen-down()
"scroll half screen down"
(interactive)
(let ((old-position joseph-scroll-screen-previous-point))
(setq joseph-scroll-screen-previous-point (point-marker))
(if (and (not (equal (marker-position old-position) (point)))
(equal last-command 'joseph-scroll-half-screen-up))
(goto-char (marker-position old-position))
(forward-visible-line (round (/ (frame-height) 1.5) ))
)
(when (and (member major-mode '(dired-mode wdired-mode))
(equal (point-max) (point)) )
(dired-previous-line 1)
)
(recenter joseph-scroll-screen-line-num)
(joseph-scroll-highlight (point-at-bol)(1+ (point-at-eol))))
(run-hooks 'joseph-scroll-half-screen-down-hook))
(defun joseph-scroll-half-screen-up()
"scroll half screen up"
(interactive)
(let ((old-position joseph-scroll-screen-previous-point))
(setq joseph-scroll-screen-previous-point (point-marker))
(if (and (not (equal (marker-position old-position) (point)))
(equal last-command 'joseph-scroll-half-screen-down))
(goto-char (marker-position old-position))
(forward-visible-line (- 0 (round (/(frame-height) 1.5)))))
(when (and (member major-mode '(dired-mode wdired-mode))
(equal (point-min) (point)))
(dired-next-line 2))
(recenter joseph-scroll-screen-line-num)
(joseph-scroll-highlight (point-at-bol)(1+ (point-at-eol))))
(run-hooks 'joseph-scroll-half-screen-up-hook))
(put 'joseph-scroll-half-screen-up 'scroll-command t)
(put 'joseph-scroll-half-screen-down 'scroll-command t)
(provide 'joseph-scroll-screen)