comparison lisp/emulation/pc-select.el @ 86155:39b88001b04b

(pc-select-shifted-mark): New var. (ensure-mark): Set it. (maybe-deactivate-mark): New fun. Use it everywhere instead of (setq mark-active nil)

86154:1cdfc94602cb

(defvar pc-select-default-key-bindings nil
  "These key bindings always get set by PC Selection mode.")

(unless pc-select-default-key-bindings
  (let ((lst
	 ;; This is to avoid confusion with the delete-selection-mode
	;; On simple displays you cant see that a region is active and
	 ;; will be deleted on the next keypress IMHO especially for
	 ;; copy-region-as-kill this is confusing.
	 ;; The same goes for exchange-point-and-mark
	 '(("\M-w" . copy-region-as-kill-nomark)
	   ("\C-x\C-x" . exchange-point-and-mark-nomark)

	   ([S-prior]   . scroll-down-mark)
	   ([prior]     . scroll-down-nomark)

	   ;; Next four lines are from Pete Forman.
	   ([C-down]    . forward-paragraph-nomark) ; KNextPara     cDn
	   ([C-up]      . backward-paragraph-nomark) ; KPrevPara     cUp
	   ([S-C-down]  . forward-paragraph-mark)
	   ([S-C-up]    . backward-paragraph-mark))))

    (setq pc-select-default-key-bindings lst)))

  "Holds the old mapping of [M-delete] in the `function-key-map'.
This variable holds the value associated with [M-delete] in the
`function-key-map' before PC Selection mode had changed that
association.")

;;;;
;; misc
;;;;

(provide 'pc-select)

;; non-interactive
;;;;
(defun ensure-mark()
  ;; make sure mark is active
  ;; test if it is active, if it isn't, set it and activate it
  (or mark-active (set-mark-command nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; forward and mark
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun forward-char-nomark (&optional arg)
  "Deactivate mark; move point right ARG characters \(left if ARG negative).
On reaching end of buffer, stop and signal error."
  (interactive "p")
  (setq mark-active nil)
  (forward-char arg))

(defun forward-word-nomark (&optional arg)
  "Deactivate mark; move point right ARG words \(backward if ARG is negative).
Normally returns t.
If an edge of the buffer is reached, point is left there
and nil is returned."
  (interactive "p")
  (setq mark-active nil)
  (forward-word arg))

(defun forward-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically down ARG lines."
  (interactive "p")
  (setq mark-active nil)
  (forward-line arg)
  (setq this-command 'forward-line)
)

(defun forward-sexp-nomark (&optional arg)
  "Deactivate mark; move forward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move backward across N balanced expressions."
  (interactive "p")
  (setq mark-active nil)
  (forward-sexp arg))

(defun forward-paragraph-nomark (&optional arg)
  "Deactivate mark; move forward to end of paragraph.
With arg N, do it N times; negative arg -N means move backward N paragraphs.

A line which `paragraph-start' matches either separates paragraphs
\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
A paragraph end is the beginning of a line which is not part of the paragraph
to which the end of the previous line belongs, or the end of the buffer."
  (interactive "p")
  (setq mark-active nil)
  (forward-paragraph arg))

(defun next-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically down ARG lines.
If there is no character in the target line exactly under the current column,

The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically.  This goal column is stored
in `goal-column', which is nil when there is none."
  (interactive "p")
  (setq mark-active nil)
  (with-no-warnings (next-line arg))
  (setq this-command 'next-line))

(defun end-of-line-nomark (&optional arg)
  "Deactivate mark; move point to end of current line.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If scan reaches end of buffer, stop there without error."
  (interactive "p")
  (setq mark-active nil)
  (end-of-line arg)
  (setq this-command 'end-of-line))

(defun backward-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically up ARG lines."
  (interactive "p")
  (setq mark-active nil)
  (if (null arg)
      (setq arg 1))
  (forward-line (- arg))
  (setq this-command 'forward-line)
)

  "Deactivate mark; scroll down ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (setq mark-active nil)
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-down arg)
	   (beginning-of-buffer (goto-char (point-min)))))
	(t (scroll-down arg))))

of the accessible part of the buffer.

Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
  (interactive "P")
  (setq mark-active nil)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (- (point-max)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!

(defun backward-char-nomark (&optional arg)
  "Deactivate mark; move point left ARG characters (right if ARG negative).
On attempt to pass beginning or end of buffer, stop and signal error."
  (interactive "p")
  (setq mark-active nil)
  (backward-char arg))

(defun backward-word-nomark (&optional arg)
  "Deactivate mark; move backward until encountering the end of a word.
With argument, do this that many times."
  (interactive "p")
  (setq mark-active nil)
  (backward-word arg))

(defun backward-sexp-nomark (&optional arg)
  "Deactivate mark; move backward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move forward across N balanced expressions."
  (interactive "p")
  (setq mark-active nil)
  (backward-sexp arg))

(defun backward-paragraph-nomark (&optional arg)
  "Deactivate mark; move backward to start of paragraph.
With arg N, do it N times; negative arg -N means move forward N paragraphs.

paragraph is preceded by a blank line, the paragraph starts at that
blank line.

See `forward-paragraph' for more information."
  (interactive "p")
  (setq mark-active nil)
  (backward-paragraph arg))

(defun previous-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically up ARG lines.
If there is no character in the target line exactly over the current column,

The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically."
  (interactive "p")
  (setq mark-active nil)
  (with-no-warnings (previous-line arg))
  (setq this-command 'previous-line))

(defun beginning-of-line-nomark (&optional arg)
  "Deactivate mark; move point to beginning of current line.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If scan reaches end of buffer, stop there without error."
  (interactive "p")
  (setq mark-active nil)
  (beginning-of-line arg))

(defun scroll-up-nomark (&optional arg)
  "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (setq mark-active nil)
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-up arg)
	   (end-of-buffer (goto-char (point-max)))))
	(t (scroll-up arg))))

of the accessible part of the buffer.

Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
  (interactive "P")
  (setq mark-active nil)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (+ (point-min)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!

  :initialize 'custom-initialize-default
  :type 'boolean
  :group 'pc-select
  :require 'pc-select)

;;; arch-tag: 10697b70-ae07-4f3e-ad23-7814a3f418c2
;;; pc-select.el ends here

86155:39b88001b04b

(defvar pc-select-default-key-bindings nil
  "These key bindings always get set by PC Selection mode.")

(unless pc-select-default-key-bindings
  (let ((lst
	 ;; This is to avoid confusion with the delete-selection-mode.
         ;; On simple displays you can't see that a region is active and
	 ;; will be deleted on the next keypress IMHO especially for
	 ;; copy-region-as-kill this is confusing.
	 ;; The same goes for exchange-point-and-mark
	 '(("\M-w" . copy-region-as-kill-nomark)
	   ("\C-x\C-x" . exchange-point-and-mark-nomark)

	   ([S-prior]   . scroll-down-mark)
	   ([prior]     . scroll-down-nomark)

	   ;; Next four lines are from Pete Forman.
	   ([C-down]    . forward-paragraph-nomark)  ; KNextPara     cDn
	   ([C-up]      . backward-paragraph-nomark) ; KPrevPara     cUp
	   ([S-C-down]  . forward-paragraph-mark)
	   ([S-C-up]    . backward-paragraph-mark))))

    (setq pc-select-default-key-bindings lst)))

  "Holds the old mapping of [M-delete] in the `function-key-map'.
This variable holds the value associated with [M-delete] in the
`function-key-map' before PC Selection mode had changed that
association.")

(defvar pc-select-shifted-mark nil
  "Holds whether we ourselves did activate the mark.  Only then
  should we deactivate if later on.")

;;;;
;; misc
;;;;

(provide 'pc-select)

;; non-interactive
;;;;
(defun ensure-mark()
  ;; make sure mark is active
  ;; test if it is active, if it isn't, set it and activate it
  (or mark-active (set-mark-command nil))
  (setq pc-select-shifted-mark t))

(defun maybe-deactivate-mark()
  ;; maybe switch off mark (only if *we* switched it on)
  (if pc-select-shifted-mark
      (progn
        (setq mark-active nil)
        (setq pc-select-shifted-mark nil))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; forward and mark
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun forward-char-nomark (&optional arg)
  "Deactivate mark; move point right ARG characters \(left if ARG negative).
On reaching end of buffer, stop and signal error."
  (interactive "p")
  (maybe-deactivate-mark)
  (forward-char arg))

(defun forward-word-nomark (&optional arg)
  "Deactivate mark; move point right ARG words \(backward if ARG is negative).
Normally returns t.
If an edge of the buffer is reached, point is left there
and nil is returned."
  (interactive "p")
  (maybe-deactivate-mark)
  (forward-word arg))

(defun forward-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically down ARG lines."
  (interactive "p")
  (maybe-deactivate-mark)
  (forward-line arg)
  (setq this-command 'forward-line)
)

(defun forward-sexp-nomark (&optional arg)
  "Deactivate mark; move forward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move backward across N balanced expressions."
  (interactive "p")
  (maybe-deactivate-mark)
  (forward-sexp arg))

(defun forward-paragraph-nomark (&optional arg)
  "Deactivate mark; move forward to end of paragraph.
With arg N, do it N times; negative arg -N means move backward N paragraphs.

A line which `paragraph-start' matches either separates paragraphs
\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
A paragraph end is the beginning of a line which is not part of the paragraph
to which the end of the previous line belongs, or the end of the buffer."
  (interactive "p")
  (maybe-deactivate-mark)
  (forward-paragraph arg))

(defun next-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically down ARG lines.
If there is no character in the target line exactly under the current column,

The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically.  This goal column is stored
in `goal-column', which is nil when there is none."
  (interactive "p")
  (maybe-deactivate-mark)
  (with-no-warnings (next-line arg))
  (setq this-command 'next-line))

(defun end-of-line-nomark (&optional arg)
  "Deactivate mark; move point to end of current line.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If scan reaches end of buffer, stop there without error."
  (interactive "p")
  (maybe-deactivate-mark)
  (end-of-line arg)
  (setq this-command 'end-of-line))

(defun backward-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically up ARG lines."
  (interactive "p")
  (maybe-deactivate-mark)
  (if (null arg)
      (setq arg 1))
  (forward-line (- arg))
  (setq this-command 'forward-line)
)

  "Deactivate mark; scroll down ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (maybe-deactivate-mark)
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-down arg)
	   (beginning-of-buffer (goto-char (point-min)))))
	(t (scroll-down arg))))

of the accessible part of the buffer.

Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
  (interactive "P")
  (maybe-deactivate-mark)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (- (point-max)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!

(defun backward-char-nomark (&optional arg)
  "Deactivate mark; move point left ARG characters (right if ARG negative).
On attempt to pass beginning or end of buffer, stop and signal error."
  (interactive "p")
  (maybe-deactivate-mark)
  (backward-char arg))

(defun backward-word-nomark (&optional arg)
  "Deactivate mark; move backward until encountering the end of a word.
With argument, do this that many times."
  (interactive "p")
  (maybe-deactivate-mark)
  (backward-word arg))

(defun backward-sexp-nomark (&optional arg)
  "Deactivate mark; move backward across one balanced expression (sexp).
With argument, do it that many times.  Negative arg -N means
move forward across N balanced expressions."
  (interactive "p")
  (maybe-deactivate-mark)
  (backward-sexp arg))

(defun backward-paragraph-nomark (&optional arg)
  "Deactivate mark; move backward to start of paragraph.
With arg N, do it N times; negative arg -N means move forward N paragraphs.

paragraph is preceded by a blank line, the paragraph starts at that
blank line.

See `forward-paragraph' for more information."
  (interactive "p")
  (maybe-deactivate-mark)
  (backward-paragraph arg))

(defun previous-line-nomark (&optional arg)
  "Deactivate mark; move cursor vertically up ARG lines.
If there is no character in the target line exactly over the current column,

The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
Then it does not try to move vertically."
  (interactive "p")
  (maybe-deactivate-mark)
  (with-no-warnings (previous-line arg))
  (setq this-command 'previous-line))

(defun beginning-of-line-nomark (&optional arg)
  "Deactivate mark; move point to beginning of current line.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If scan reaches end of buffer, stop there without error."
  (interactive "p")
  (maybe-deactivate-mark)
  (beginning-of-line arg))

(defun scroll-up-nomark (&optional arg)
  "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
When calling from a program, supply a number as argument or nil."
  (interactive "P")
  (maybe-deactivate-mark)
  (cond (pc-select-override-scroll-error
	 (condition-case nil (scroll-up arg)
	   (end-of-buffer (goto-char (point-max)))))
	(t (scroll-up arg))))

of the accessible part of the buffer.

Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
  (interactive "P")
  (maybe-deactivate-mark)
  (let ((size (- (point-max) (point-min))))
    (goto-char (if arg
		   (+ (point-min)
		      (if (> size 10000)
			  ;; Avoid overflow for large buffer sizes!

  :initialize 'custom-initialize-default
  :type 'boolean
  :group 'pc-select
  :require 'pc-select)

;; arch-tag: 10697b70-ae07-4f3e-ad23-7814a3f418c2
;;; pc-select.el ends here