Download
(provide 'mark-lines)
(defgroup mark-lines nil
"Whole line marking."
:prefix "mark-lines"
:group 'editing
:group 'convenience)
(defcustom mark-lines-verbose nil
"*Output status messages to minibuffer if t."
:type 'boolean
:group 'mark-lines)
(defcustom mark-lines-electric t
"*Non-nill means when the region deactivates, try to point to a place of
interest."
:type 'boolean
:group 'mark-lines)
(defvar mark-lines nil
"is t when a mark-line is active")
(unless (fboundp 'region-active-p)
(defun region-active-p ()
"Xemacs compatibility."
mark-active))
(defmacro zmacs-region-stay-please ()
"make region stay in XEmacs."
(when (boundp 'zmacs-region-stays)
'(setq zmacs-region-stays t)))
(add-hook (eval-and-compile
(if (boundp 'zmacs-deactivate-region-hook)
'zmacs-deactivate-region-hook
'deactivate-mark-hook))
'mark-lines-deactivate-hook)
(defadvice next-line (around mark-lines activate)
"support whole line marking."
(zmacs-region-stay-please)
(if mark-lines
(let ((goal-column 0)
old-point
mark-is-beginning)
(unless (mark-lines-setup-region)
(setq old-point (point)
mark-is-beginning (eq (region-beginning) (mark)))
ad-do-it
(if mark-is-beginning
(when (> (mark) (point))
(set-mark (save-excursion
(goto-char (mark))
(point-at-bol 2))))
(when (<= (mark) (point))
(when (= (mark) (point))
(forward-line 1))
(set-mark (save-excursion
(goto-char (mark))
(point-at-bol 0)))))))
ad-do-it))
(defadvice previous-line (around mark-lines activate)
"support whole line marking."
(zmacs-region-stay-please)
(if mark-lines
(let ((goal-column 0)
old-point
old-point-is-beginning)
(unless (mark-lines-setup-region)
(setq old-point (point)
old-point-is-beginning (eq (region-beginning) old-point))
ad-do-it
(if old-point-is-beginning
(when (> (point) (mark))
(set-mark (save-excursion
(goto-char (mark))
(point-at-bol 0))))
(when (<= (point) (mark))
(when (= (point) (mark))
(forward-line -1))
(set-mark (save-excursion
(goto-char (mark))
(point-at-bol 2)))))))
ad-do-it))
(defun mark-lines-deactivate ()
"deactivate mark-lines"
(setq mark-lines nil)
(when mark-lines-verbose
(message "mark-lines stopped.")))
(defun mark-lines-deactivate-hook ()
"function run from deactivate region hook."
(when (and mark-lines-electric
mark-lines
(bolp))
(skip-chars-forward " \t")
(when (or (memq 'font-lock-comment-face
(text-properties-at (point)))
(and comment-start
(looking-at (regexp-quote comment-start))))
(when (looking-at comment-start-skip)
(goto-char (match-end 0)))))
(mark-lines-deactivate))
(defun mark-lines-activate ()
"deactivate `mark-lines'"
(setq mark-lines t)
(when mark-lines-verbose
(message "mark-lines started.")))
(defun mark-lines-setup-region ()
"set up the region to ge whole lines only.
The mark and point are modified. The region is expanded in such a way that
the displacements of mark and point are minimal.
Return t if point or mark had to be moved.
BUG: goto the end of a buffer that's not an empty line, try <C-x> <C-p> then,
<C-p>, it crashes."
(when (region-active-p)
(let ((p (point))
result)
(if (< p (mark))
(progn
(unless (or (bolp) (eobp))
(forward-line 0)
(setq result t))
(goto-char (mark))
(unless (or (bolp) (eobp))
(set-mark (point-at-bol))
(setq result t))
(goto-char p))
(goto-char (mark))
(unless (or (bolp) (eobp))
(set-mark (point-at-bol))
(setq result t))
(goto-char p)
(unless (or (bolp) (eobp))
(forward-line 1)
(setq result t)))
result)))
(defun mark-lines--move (movement-command arg)
"internal function.
see \\[mark-lines-previous-line] and \\[mark-lines-next-line]."
(let ((was-marking-lines mark-lines))
(cond ((and arg
(listp arg))
(when mark-lines
(mark-lines-deactivate)))
((not arg)
(setq arg 1)
(when (not mark-lines)
(mark-lines-activate)))
((when (not mark-lines)
(mark-lines-activate))))
(when mark-lines
(if (region-active-p)
(if (not was-marking-lines)
(funcall movement-command arg)
(exchange-point-and-mark)
(funcall movement-command arg)
(exchange-point-and-mark))
(if (and (eq movement-command 'previous-line)
(= 1 (forward-line 1)))
(push-mark (point-at-eol))
(push-mark (point-at-bol) t t))
(funcall movement-command arg)))))
(defun mark-lines-previous-line (arg)
"mark the current line and move up ARG line.
If the region is already active, and it's a whole-lines region, move mark up ARG
lines.
If the region is active, but not a whole-lines region, expand it so that it
becomes a whole region.
If the universal argument is received, turn mark-lines off for the currently
active region.
Otherwose arg is treated exactly as `previous-line'."
(interactive "P")
(mark-lines--move 'previous-line arg))
(defun mark-lines-next-line (arg)
"same as `mark-lines-previous-line', going in the other direction."
(interactive "P")
(mark-lines--move 'next-line arg))