xemacs-beta: lisp/simple.el comparison

comparison lisp/simple.el @ 462:0784d089fdc9 r21-2-46

Import from CVS: tag r21-2-46

author	cvs
date	Mon, 13 Aug 2007 11:44:37 +0200
parents	3078fd1074e8
children	54fa1a5c2d12

comparison

equal deleted inserted replaced

-:120ed4009e51
+:0784d089fdc9
 With arg N, put point N/10 of the way from the beginning.
 If the buffer is narrowed, this command uses the beginning and size
 of the accessible part of the buffer.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details.
 Don't use this command in Lisp programs!
 \(goto-char (point-min)) is faster and avoids clobbering the mark."
 ;; XEmacs change
 (interactive "_P")
 (push-mark)
 "Move point to the end of the buffer; leave mark at previous position.
 With arg N, put point N/10 of the way from the end.
 If the buffer is narrowed, this command uses the beginning and size
 of the accessible part of the buffer.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details.
 Don't use this command in Lisp programs!
 \(goto-char (point-max)) is faster and avoids clobbering the mark."
 ;; XEmacs change
 (interactive "_P")
 (interactive "_p")
 (forward-line (- count))
 (skip-chars-forward " \t"))
 (defcustom kill-whole-line nil
-"*Control when and whether `kill-line' removes entire lines.
+"*If non-nil, kill the whole line if point is at the beginning.
-Note: This only applies when `kill-line' is called interactively;
+Otherwise, `kill-line' kills only up to the end of the line, but not
-otherwise, it behaves \"historically\".
+the terminating newline.  Note: This only applies when `kill-line' is
+called interactively.
-If `always', `kill-line' with no arg always kills the whole line,
-wherever point is in the line. (If you want to just kill to the end
+WARNING: This is a misnamed variable!  It should be called something
-of the line, use \\[historical-kill-line].)
+like `kill-whole-line-when-at-beginning'.  If you simply want
+\\[kill-line] to kill the entire current line, bind it to the function
-If not `always' but non-nil, `kill-line' with no arg kills the whole
+`kill-entire-line'.  "
-line if point is at the beginning, and otherwise behaves historically.
+:type 'boolean
-If nil, `kill-line' behaves historically."
-:type '(radio (const :tag "Kill to end of line" nil)
-		(const :tag "Kill whole line" always)
-		(const
-		 :tag "Kill whole line at beginning, otherwise end of line" t))
 :group 'killing)
-(defun historical-kill-line (&optional arg)
+(defun kill-line-1 (arg entire-line interactive-p)
-"Same as `kill-line' but ignores value of `kill-whole-line'."
+(kill-region (if entire-line
-(interactive "*P")
-(let ((kill-whole-line nil))
-(if (interactive-p)
-	(call-interactively 'kill-line)
-(kill-line arg))))
-(defun kill-line (&optional arg)
-"Kill the rest of the current line, or the entire line.
-If no nonblanks there, kill thru newline.
-If called interactively, may kill the entire line; see `kill-whole-line'.
-when given no argument at the beginning of a line.
-With prefix argument, kill that many lines from point.
-Negative arguments kill lines backward.
-When calling from a program, nil means \"no arg\",
-a number counts as a prefix arg."
-(interactive "*P")
-(kill-region (if (and (interactive-p)
-			(not arg)
-			(eq kill-whole-line 'always))
 		   (save-excursion
 		     (beginning-of-line)
 		     (point))
 		 (point))
 	       ;; Don't shift point before doing the delete; that way,
 		 (if arg
 		     (forward-line (prefix-numeric-value arg))
 		   (if (eobp)
 		       (signal 'end-of-buffer nil))
 		   (if (or (looking-at "[ \t]*$")
-			   (and (interactive-p)
+			   (or entire-line
-				(or (eq kill-whole-line 'always)
+			       (and interactive-p
 				    (and kill-whole-line (bolp)))))
 		       (forward-line 1)
 		     (end-of-line)))
 		 (point))))
+(defun kill-entire-line (&optional arg)
+"Kill the entire line.
+With prefix argument, kill that many lines from point.  Negative
+arguments kill lines backward.
+When calling from a program, nil means \"no arg\",
+a number counts as a prefix arg."
+(interactive "*P")
+(kill-line-1 arg t (interactive-p)))
+(defun kill-line (&optional arg)
+"Kill the rest of the current line, or the entire line.
+If no nonblanks there, kill thru newline.  If called interactively,
+may kill the entire line when given no argument at the beginning of a
+line; see `kill-whole-line'.  With prefix argument, kill that many
+lines from point.  Negative arguments kill lines backward.
+WARNING: This is a misnamed function!  It should be called something
+like `kill-to-end-of-line'.  If you simply want to kill the entire
+current line, use `kill-entire-line'.
+When calling from a program, nil means \"no arg\",
+a number counts as a prefix arg."
+(interactive "*P")
+(kill-line-1 arg nil (interactive-p)))
 ;; XEmacs
 (defun backward-kill-line nil
 "Kill back to the beginning of the line."
 (interactive)
 The special value `shifted-motion-commands' causes marks set as a result
 of selection using any shifted motion commands to not be recorded.
 The value `yank' affects all yank-like commands, as well as just `yank'."
 :type '(repeat (choice (const :tag "shifted motion commands"
-				'shifted-motion-commands)
+				shifted-motion-commands)
 			 (const :tag "functions that select text"
 				:inline t
-				'(mark-beginning-of-buffer
+				(mark-beginning-of-buffer
-				  mark-bob
+				 mark-bob
-				  mark-defun
+				 mark-defun
-				  mark-end-of-buffer
+				 mark-end-of-buffer
-				  mark-end-of-line
+				 mark-end-of-line
-				  mark-end-of-sentence
+				 mark-end-of-sentence
-				  mark-eob
+				 mark-eob
-				  mark-marker
+				 mark-marker
-				  mark-page
+				 mark-page
-				  mark-paragraph
+				 mark-paragraph
-				  mark-sexp
+				 mark-sexp
-				  mark-whole-buffer
+				 mark-whole-buffer
-				  mark-word))
+				 mark-word))
 			 (const :tag "functions that paste text"
-				'yank)
+				yank)
 			 function))
 :group 'killing)
 (defcustom mark-ring-max 16
 "*Maximum size of mark ring.  Start discarding off end if gets this big."
 (goto-char position)
 (switch-to-buffer buffer)))
 (defcustom signal-error-on-buffer-boundary t
-"*Non-nil value causes XEmacs to beep or signal an error when certain interactive commands would move point past (point-min) or (point-max).
+"*If Non-nil, beep or signal an error when moving past buffer boundary.
 The commands that honor this variable are
 forward-char-command
 backward-char-command
 next-line
 :type 'boolean
 :group 'editing-basics)
 (defcustom shifted-motion-keys-select-region t
 "*If non-nil, shifted motion keys select text, like in MS Windows.
-See also `unshifted-motion-keys-deselect-region'."
+More specifically, if a keystroke that matches one of the key
+specifications in `motion-keys-for-shifted-motion' is pressed along
+with the Shift key, and the command invoked moves the cursor and
+preserves the active region (see `zmacs-region-stays'), the
+intervening text will be added to the active region.
+When the region has been enabled or augmented as a result of a shifted
+motion key, an unshifted motion key will normally deselect the region.
+However, if `unshifted-motion-keys-deselect-region' is t, the region
+will remain active, augmented by the characters moved over by this
+motion key.
+This functionality is specifically interpreted in terms of keys, and
+*NOT* in terms of particular commands, because that produces the most
+intuitive behavior: `forward-char' will work with shifted motion
+when invoked by `right' but not `C-f', and user-written motion commands
+bound to motion keys will automatically work with shifted motion."
 :type 'boolean
 :group 'editing-basics)
 (defcustom unshifted-motion-keys-deselect-region t
 "*If non-nil, unshifted motion keys deselect a shifted-motion region.
-This only occurs after a region has been selected using shifted motion keys
+This only occurs after a region has been selected or augmented using
-(not when using the traditional set-mark-then-move method), and has no effect
+shifted motion keys (not when using the traditional set-mark-then-move
-if `shifted-motion-keys-select-region' is nil."
+method), and has no effect if `shifted-motion-keys-select-region' is
+nil."
 :type 'boolean
 :group 'editing-basics)
+(defcustom motion-keys-for-shifted-motion
+'(left right up down home end prior next
+	 kp-left kp-right kp-up kp-down kp-home kp-end kp-prior kp-next)
+"*List of keys considered motion keys for the purpose of shifted selection.
+When one of these keys is pressed along with the Shift key, and the
+command invoked moves the cursor and preserves the active region (see
+`zmacs-region-stays'), the intervening text will be added to the active
+region.  See `shifted-motion-keys-select-region' for more details.
+Each entry should be a keysym or a list (MODIFIERS ... KEYSYM),
+i.e. zero or more modifiers followed by a keysym.  When a keysym alone
+is given, a keystroke consisting of that keysym, with or without any
+modifiers, is considered a motion key.  When the list form is given,
+only a keystroke with exactly those modifiers and no others (with the
+exception of the Shift key) is considered a motion key.
+NOTE: Currently, the keysym cannot be a non-alphabetic character key
+such as the `=/+' key.  In any case, the shifted-motion paradigm does
+not make much sense with those keys.  The keysym can, however, be an
+alphabetic key without problem, and you can specify the key using
+either a character or a symbol, uppercase or lowercase."
+:type '(repeat (choice (const :tag "normal cursor-pad (\"gray\") keys"
+				:inline t
+				(left right up down home end prior next))
+			 (const :tag "keypad motion keys"
+				:inline t
+				(kp-left kp-right kp-up kp-down
+					 kp-home kp-end kp-prior kp-next))
+			 (const :tag "alphabetic motion keys"
+				:inline t
+				((control b) (control f)
+				 (control p) (control n)
+				 (control a) (control e)
+				 (control v) (meta v)
+				 (meta b) (meta f)
+				 (meta a) (meta e)
+				 (meta m) ; back-to-indentation
+				 (meta r) ; move-to-window-line
+				 (meta control b) (meta control f)
+				 (meta control p) (meta control n)
+				 (meta control a) (meta control e)
+				 (meta control d) ;; down-list
+				 (meta control u) ;; backward-up-list
+				 ))
+			 symbol))
+:group 'editing-basics)
 (defun handle-pre-motion-command-current-command-is-motion ()
 (and (key-press-event-p last-input-event)
-(memq (event-key last-input-event)
+(let ((key (event-key last-input-event))
-	'(left right up down home end prior next
+	     (mods (delq 'shift (event-modifiers last-input-event))))
-	       kp-left kp-right kp-up kp-down
+	 ;(princ (format "key: %s mods: %s\n" key mods) 'external-debugging-output)
-	       kp-home kp-end kp-prior kp-next))))
+	 (catch 'handle-pre-motion-command-current-command-is-motion
+	   (flet ((keysyms-equal (a b)
+		    (if (characterp a)
+			(setq a (intern (char-to-string (downcase a)))))
+		    (if (characterp b)
+			(setq b (intern (char-to-string (downcase b)))))
+		    (eq a b)))
+	     (mapc #'(lambda (keysym)
+		       (when (if (listp keysym)
+				 (and (equal mods (butlast keysym))
+				      (keysyms-equal key (car (last keysym))))
+			       (keysyms-equal key keysym))
+			 (throw
+			  'handle-pre-motion-command-current-command-is-motion
+			  t)))
+		   motion-keys-for-shifted-motion)
+	     nil)))))
 (defun handle-pre-motion-command ()
-(if
+(if (and
-(and
 (handle-pre-motion-command-current-command-is-motion)
 zmacs-regions
 shifted-motion-keys-select-region
 (not (region-active-p))
-(memq 'shift (event-modifiers last-input-event)))
+;; Special-case alphabetic keysyms, because the `shift'
+;; modifier does not appear on them. (Unfortunately, we have no
+;; way of determining Shift-key status on non-alphabetic ASCII
+;; keysyms.  However, in this case, using Shift will invoke a
+;; separate command from the non-shifted version, so the
+;; "shifted motion" paradigm makes no sense.)
+(or (memq 'shift (event-modifiers last-input-event))
+	   (let ((key (event-key last-input-event)))
+	     (and (characterp key)
+		  (not (eq key (downcase key)))))))
 (let ((in-shifted-motion-command t))
 	(push-mark nil nil t))))
 (defun handle-post-motion-command ()
 (if
 (and
 (handle-pre-motion-command-current-command-is-motion)
 zmacs-regions
 (region-active-p))
-(cond ((memq 'shift (event-modifiers last-input-event))
+;; Special-case alphabetic keysyms, because the `shift'
+;; modifier does not appear on them.  See above.
+(cond ((or (memq 'shift (event-modifiers last-input-event))
+		 (let ((key (event-key last-input-event)))
+		   (and (characterp key)
+			(not (eq key (downcase key))))))
 	     (if shifted-motion-keys-select-region
 		 (putf this-command-properties 'shifted-motion-command t))
 	     (setq zmacs-region-stays t))
 	    ((and (getf last-command-properties 'shifted-motion-command)
 		  unshifted-motion-keys-deselect-region)
 (defun forward-char-command (&optional arg buffer)
 "Move point right ARG characters (left if ARG negative) in BUFFER.
 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
 Error signaling is suppressed if `signal-error-on-buffer-boundary'
-is nil.  If BUFFER is nil, the current buffer is assumed."
+is nil.  If BUFFER is nil, the current buffer is assumed.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details."
 (interactive "_p")
 (if signal-error-on-buffer-boundary
 (forward-char arg buffer)
 (condition-case nil
 	(forward-char arg buffer)
 (defun backward-char-command (&optional arg buffer)
 "Move point left ARG characters (right if ARG negative) in BUFFER.
 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
 Error signaling is suppressed if `signal-error-on-buffer-boundary'
-is nil.  If BUFFER is nil, the current buffer is assumed."
+is nil.  If BUFFER is nil, the current buffer is assumed.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details."
 (interactive "_p")
 (if signal-error-on-buffer-boundary
 (backward-char arg buffer)
 (condition-case nil
 	(backward-char arg buffer)
 Negative N means scroll downward.
 When calling from a program, supply a number as argument or nil.
 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
 signaled.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details.
 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
 boundaries do not cause an error to be signaled."
 (interactive "_P")
 (if signal-error-on-buffer-boundary
 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
 signaled.
 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
-boundaries do not cause an error to be signaled."
+boundaries do not cause an error to be signaled.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details."
 (interactive "_P")
 (if signal-error-on-buffer-boundary
 (scroll-down n)
 (condition-case nil
 	(scroll-down n)
 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.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details.
 If you are thinking of using this in a Lisp program, consider
 using `forward-line' instead.  It is usually easier to use
 and more reliable (no dependence on goal column, etc.)."
 (interactive "_p")
 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.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details.
 If you are thinking of using this in a Lisp program, consider using
 `forward-line' with a negative argument instead.  It is usually easier
 to use and more reliable (no dependence on goal column, etc.)."
 (interactive "_p")
 (if (interactive-p)
 :group 'editing-basics)
 (defun backward-block-of-lines ()
 "Move backward by one \"block\" of lines.
 The number of lines that make up a block is controlled by
-`block-movement-size', which defaults to 6."
+`block-movement-size', which defaults to 6.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details."
 (interactive "_")
 (forward-line (- block-movement-size)))
 (defun forward-block-of-lines ()
 "Move forward by one \"block\" of lines.
 The number of lines that make up a block is controlled by
-`block-movement-size', which defaults to 6."
+`block-movement-size', which defaults to 6.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details."
 (interactive "_")
 (forward-line block-movement-size))
 (defcustom track-eol nil
 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
 (defun backward-word (&optional count buffer)
 "Move point backward COUNT words (forward if COUNT is negative).
 Normally t is returned, but if an edge of the buffer is reached,
 point is left there and nil is returned.
-COUNT defaults to 1, and BUFFER defaults to the current buffer."
+COUNT defaults to 1, and BUFFER defaults to the current buffer.
+The characters that are moved over may be added to the current selection
+\(i.e. active region) if the Shift key is held down, a motion key is used
+to invoke this command, and `shifted-motion-keys-select-region' is t; see
+the documentation for this variable for more details."
 (interactive "_p")
 (forward-word (- (or count 1)) buffer))
 (defun mark-word (&optional count)
 "Mark the text from point until encountering the end of a word.

Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 462:0784d089fdc9 r21-2-46