X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c86c975de6cb7f56c7a54daee73177500a78b85b..3bd9ca85049a253b7640c81da9b1436d93a44f6d:/lisp/simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 39a34f7f4a..46bfc12dc4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -352,16 +352,16 @@ useful for editing binary files."
       (insert-and-inherit char)
       (setq arg (1- arg)))))
 
-(defun forward-to-indentation (arg)
+(defun forward-to-indentation (&optional arg)
   "Move forward ARG lines and position at first nonblank character."
   (interactive "p")
-  (forward-line arg)
+  (forward-line (or arg 1))
   (skip-chars-forward " \t"))
 
-(defun backward-to-indentation (arg)
+(defun backward-to-indentation (&optional arg)
   "Move backward ARG lines and position at first nonblank character."
   (interactive "p")
-  (forward-line (- arg))
+  (forward-line (- (or arg 1)))
   (skip-chars-forward " \t"))
 
 (defun back-to-indentation ()
@@ -661,8 +661,10 @@ the echo area."
 
   (let ((print-length eval-expression-print-length)
 	(print-level eval-expression-print-level))
-    (prin1 (car values)
-	   (if eval-expression-insert-value (current-buffer) t))))
+    (if eval-expression-insert-value
+	(with-no-warnings
+	 (eval-last-sexp-print-value (car values)))
+      (prin1 (car values) t))))
 
 (defun edit-and-eval-command (prompt command)
   "Prompting with PROMPT, let user edit COMMAND and eval result.
@@ -1025,7 +1027,9 @@ A numeric argument serves as a repeat count.
 Contrary to `undo', this will not redo a previous undo."
   (interactive "*p")
   (let ((undo-no-redo t)) (undo arg)))
-(define-key ctl-x-map "U" 'undo-only)
+;; Richard said that we should not use C-x <uppercase letter> and I have
+;; no idea whereas to bind it.  Any suggestion welcome.  -stef
+;; (define-key ctl-x-map "U" 'undo-only)
 
 (defvar pending-undo-list nil
   "Within a run of consecutive undo commands, list remaining to be undone.")
@@ -1348,7 +1352,7 @@ specifies the value of ERROR-BUFFER."
 		  (setq proc (start-process "Shell" buffer shell-file-name
 					    shell-command-switch command))
 		  (setq mode-line-process '(":%s"))
-		  (shell-mode)
+		  (require 'shell) (shell-mode)
 		  (set-process-sentinel proc 'shell-command-sentinel)
 		  ))
 	    (shell-command-on-region (point) (point) command
@@ -1809,8 +1813,7 @@ may access and use elements from the kill-ring directly, the STRING
 argument should still be a \"useful\" string for such uses."
   (if (> (length string) 0)
       (if yank-handler
-	  (put-text-property 0 1 'yank-handler yank-handler string)
-	(remove-list-of-text-properties 0 1 '(yank-handler) string))
+	  (put-text-property 0 1 'yank-handler yank-handler string))
     (if yank-handler
 	(signal 'args-out-of-range
 		(list string "yank-handler specified for empty string"))))
@@ -1911,7 +1914,8 @@ text property to be set on the killed text.  See `insert-for-yank'."
 	  (if (eq last-command 'kill-region)
 	      (kill-append string (< end beg) yank-handler)
 	    (kill-new string nil yank-handler)))
-	(setq this-command 'kill-region))
+	(when (or string (eq last-command 'kill-region))
+	  (setq this-command 'kill-region)))
     ((buffer-read-only text-read-only)
      ;; The code above failed because the buffer, or some of the characters
      ;; in the region, are read-only.
@@ -2003,7 +2007,9 @@ The argument is used for internal purposes; do not supply one."
 (defcustom yank-excluded-properties
   '(read-only invisible intangible field mouse-face help-echo local-map keymap
     yank-handler)
-  "*Text properties to discard when yanking."
+  "*Text properties to discard when yanking.
+The value should be a list of text properties to discard or t,
+which means to discard all text properties."
   :type '(choice (const :tag "All" t) (repeat symbol))
   :group 'editing
   :version "21.4")
@@ -2205,6 +2211,43 @@ even beep.)"
 		       (goto-char end))))
 		 (point))))
 
+(defun kill-whole-line (&optional arg)
+  "Kill current line.
+With prefix arg, kill that many lines starting from the current line.
+If arg is negative, kill backward.  Also kill the preceding newline.
+\(This is meant to make C-x z work well with negative arguments.\)
+If arg is zero, kill current line but exclude the trailing newline."
+  (interactive "P")
+  (setq arg (prefix-numeric-value arg))
+  (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
+      (signal 'end-of-buffer nil))
+  (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
+      (signal 'beginning-of-buffer nil))
+  (unless (eq last-command 'kill-region)
+    (kill-new "")
+    (setq last-command 'kill-region))
+  (cond ((zerop arg)
+	 ;; We need to kill in two steps, because the previous command
+	 ;; could have been a kill command, in which case the text
+	 ;; before point needs to be prepended to the current kill
+	 ;; ring entry and the text after point appended.  Also, we
+	 ;; need to use save-excursion to avoid copying the same text
+	 ;; twice to the kill ring in read-only buffers.
+	 (save-excursion
+	   (kill-region (point) (progn (forward-visible-line 0) (point))))
+	 (kill-region (point) (progn (end-of-visible-line) (point))))
+	((< arg 0)
+	 (save-excursion
+	   (kill-region (point) (progn (end-of-visible-line) (point))))
+	 (kill-region (point)
+		      (progn (forward-visible-line (1+ arg))
+			     (unless (bobp) (backward-char))
+			     (point))))
+	(t
+	 (save-excursion
+	   (kill-region (point) (progn (forward-visible-line 0) (point))))
+	 (kill-region (point)
+		      (progn (forward-visible-line arg) (point))))))
 
 (defun forward-visible-line (arg)
   "Move forward by ARG lines, ignoring currently invisible newlines only.
@@ -2244,8 +2287,8 @@ If ARG is zero, move to the beginning of the current line."
 	      (unless (bolp)
 		(goto-char opoint))))
 	(let ((first t))
-	  (while (or first (< arg 0))
-	    (if (zerop arg)
+	  (while (or first (<= arg 0))
+	    (if first
 		(beginning-of-line)
 	      (or (zerop (forward-line -1))
 		  (signal 'beginning-of-buffer nil)))
@@ -2254,13 +2297,12 @@ If ARG is zero, move to the beginning of the current line."
 	    (unless (bobp)
 	      (let ((prop
 		     (get-char-property (1- (point)) 'invisible)))
-		(if (if (eq buffer-invisibility-spec t)
-			prop
-		      (or (memq prop buffer-invisibility-spec)
-			  (assq prop buffer-invisibility-spec)))
-		    (setq arg (1+ arg)))))
-	    (setq first nil)
-	    (setq arg (1+ arg)))
+		(unless (if (eq buffer-invisibility-spec t)
+			    prop
+			  (or (memq prop buffer-invisibility-spec)
+			      (assq prop buffer-invisibility-spec)))
+		  (setq arg (1+ arg)))))
+	    (setq first nil))
 	  ;; If invisible text follows, and it is a number of complete lines,
 	  ;; skip it.
 	  (let ((opoint (point)))
@@ -2534,13 +2576,11 @@ Novice Emacs Lisp programmers often try to use the mark for the wrong
 purposes.  See the documentation of `set-mark' for more information.
 
 In Transient Mark mode, this does not activate the mark."
-  (if (null (mark t))
-      nil
+  (unless (null (mark t))
     (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
-    (if (> (length mark-ring) mark-ring-max)
-	(progn
-	  (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
-	  (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
+    (when (> (length mark-ring) mark-ring-max)
+      (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+      (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
   (set-marker (mark-marker) (or location (point)) (current-buffer))
   ;; Now push the mark on the global mark ring.
   (if (and global-mark-ring
@@ -2549,11 +2589,9 @@ In Transient Mark mode, this does not activate the mark."
       ;; Don't push another one.
       nil
     (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
-    (if (> (length global-mark-ring) global-mark-ring-max)
-	(progn
-	  (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
-		       nil)
-	  (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
+    (when (> (length global-mark-ring) global-mark-ring-max)
+      (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
+      (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
   (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
       (message "Mark set"))
   (if (or activate (not transient-mark-mode))
@@ -2563,14 +2601,13 @@ In Transient Mark mode, this does not activate the mark."
 (defun pop-mark ()
   "Pop off mark ring into the buffer's actual mark.
 Does not set point.  Does nothing if mark ring is empty."
-  (if mark-ring
-      (progn
-	(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
-	(set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
-	(deactivate-mark)
-	(move-marker (car mark-ring) nil)
-	(if (null (mark t)) (ding))
-	(setq mark-ring (cdr mark-ring)))))
+  (when mark-ring
+    (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+    (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+    (deactivate-mark)
+    (move-marker (car mark-ring) nil)
+    (if (null (mark t)) (ding))
+    (setq mark-ring (cdr mark-ring))))
 
 (defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
 (defun exchange-point-and-mark (&optional arg)
@@ -2662,7 +2699,7 @@ 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")
-  (unless arg (setq arg 1))
+  (or arg (setq arg 1))
   (if (and next-line-add-newlines (= arg 1))
       (if (save-excursion (end-of-line) (eobp))
 	  ;; When adding a newline, don't expand an abbrev.
@@ -2694,7 +2731,7 @@ 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")
-  (unless arg (setq arg 1))
+  (or arg (setq arg 1))
   (if (interactive-p)
       (condition-case nil
 	  (line-move (- arg))
@@ -3074,11 +3111,11 @@ With argument 0, interchanges line point is in with line mark is in."
      (goto-char (car pos1))
      (insert word2))))
 
-(defun backward-word (arg)
+(defun backward-word (&optional arg)
   "Move backward until encountering the beginning of a word.
 With argument, do this that many times."
   (interactive "p")
-  (forward-word (- arg)))
+  (forward-word (- (or arg 1))))
 
 (defun mark-word (arg)
   "Set mark arg words away from point.
@@ -3110,37 +3147,42 @@ With argument, do this that many times."
   (interactive "p")
   (kill-word (- arg)))
 
-(defun current-word (&optional strict)
-  "Return the word point is on (or a nearby word) as a string.
+(defun current-word (&optional strict really-word)
+  "Return the symbol or word that point is on (or a nearby one) as a string.
+The return value includes no text properties.
 If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a word."
+or adjacent to a symbol or word.
+The function, belying its name, normally finds a symbol.
+If optional arg REALLY-WORD is non-nil, it finds just a word."
   (save-excursion
-    (let ((oldpoint (point)) (start (point)) (end (point)))
-      (skip-syntax-backward "w_") (setq start (point))
+    (let* ((oldpoint (point)) (start (point)) (end (point))
+	   (syntaxes (if really-word "w" "w_"))
+	   (not-syntaxes (concat "^" syntaxes)))
+      (skip-syntax-backward syntaxes) (setq start (point))
       (goto-char oldpoint)
-      (skip-syntax-forward "w_") (setq end (point))
-      (if (and (eq start oldpoint) (eq end oldpoint))
-	  ;; Point is neither within nor adjacent to a word.
-	  (and (not strict)
-	       (progn
-		 ;; Look for preceding word in same line.
-		 (skip-syntax-backward "^w_"
-				       (save-excursion (beginning-of-line)
-						       (point)))
-		 (if (bolp)
-		     ;; No preceding word in same line.
-		     ;; Look for following word in same line.
-		     (progn
-		       (skip-syntax-forward "^w_"
-					    (save-excursion (end-of-line)
-							    (point)))
-		       (setq start (point))
-		       (skip-syntax-forward "w_")
-		       (setq end (point)))
-		   (setq end (point))
-		   (skip-syntax-backward "w_")
-		   (setq start (point)))
-		 (buffer-substring-no-properties start end)))
+      (skip-syntax-forward syntaxes) (setq end (point))
+      (when (and (eq start oldpoint) (eq end oldpoint)
+		 ;; Point is neither within nor adjacent to a word.
+		 (not strict))
+	;; Look for preceding word in same line.
+	(skip-syntax-backward not-syntaxes
+			      (save-excursion (beginning-of-line)
+					      (point)))
+	(if (bolp)
+	    ;; No preceding word in same line.
+	    ;; Look for following word in same line.
+	    (progn
+	      (skip-syntax-forward not-syntaxes
+				   (save-excursion (end-of-line)
+						   (point)))
+	      (setq start (point))
+	      (skip-syntax-forward syntaxes)
+	      (setq end (point)))
+	  (setq end (point))
+	  (skip-syntax-backward syntaxes)
+	  (setq start (point))))
+      ;; If we found something nonempty, return it as a string.
+      (unless (= start end)
 	(buffer-substring-no-properties start end)))))
 
 (defcustom fill-prefix nil
@@ -3458,7 +3500,8 @@ when it is off screen)."
 			   (point)))))
        (let* ((oldpos (point))
 	      (blinkpos)
-	      (mismatch))
+	      (mismatch)
+	      matching-paren)
 	 (save-excursion
 	   (save-restriction
 	     (if blink-matching-paren-distance
@@ -3472,12 +3515,20 @@ when it is off screen)."
 		   (setq blinkpos (scan-sexps oldpos -1)))
 	       (error nil)))
 	   (and blinkpos
-		(/= (char-syntax (char-after blinkpos))
-		    ?\$)
-		(setq mismatch
-		      (or (null (matching-paren (char-after blinkpos)))
+		(save-excursion
+		  (goto-char blinkpos)
+		  (not (looking-at "\\s$")))
+		(setq matching-paren
+		      (or (and parse-sexp-lookup-properties
+			       (let ((prop (get-text-property blinkpos 'syntax-table)))
+				 (and (consp prop)
+				      (eq (car prop) 4)
+				      (cdr prop))))
+			  (matching-paren (char-after blinkpos)))
+		      mismatch
+		      (or (null matching-paren)
 			  (/= (char-after (1- oldpos))
-			      (matching-paren (char-after blinkpos))))))
+			      matching-paren))))
 	   (if mismatch (setq blinkpos nil))
 	   (if blinkpos
 	       ;; Don't log messages about paren matching.
@@ -3943,9 +3994,8 @@ to decide what to delete."
   ;; unless it is reading a file name and CHOICE is a directory,
   ;; or completion-no-auto-exit is non-nil.
 
-  (let ((buffer (or buffer completion-reference-buffer))
-	(mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
-			      (buffer-name buffer))))
+  (let* ((buffer (or buffer completion-reference-buffer))
+	 (mini-p (minibufferp buffer)))
     ;; If BUFFER is a minibuffer, barf unless it's the currently
     ;; active minibuffer.
     (if (and mini-p
@@ -4431,8 +4481,34 @@ See also `normal-erase-is-backspace'."
   (if (interactive-p)
       (message "Delete key deletes %s"
 	       (if normal-erase-is-backspace "forward" "backward"))))
-
-
+
+(defcustom idle-update-delay 0.5
+  "*Idle time delay before updating various things on the screen.
+Various Emacs features that update auxiliary information when point moves
+wait this many seconds after Emacs becomes idle before doing an update."
+  :type 'number
+  :group 'display
+  :version "21.4")
+
+(defvar vis-mode-saved-buffer-invisibility-spec nil
+  "Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+
+(define-minor-mode visible-mode
+  "Toggle Visible mode.
+With argument ARG turn Visible mode on iff ARG is positive.
+
+Enabling Visible mode makes all invisible text temporarily visible.
+Disabling Visible mode turns off that effect.  Visible mode
+works by saving the value of `buffer-invisibility-spec' and setting it to nil."
+  :lighter " Vis"
+  (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
+    (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
+    (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
+  (when visible-mode
+    (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
+	 buffer-invisibility-spec)
+    (setq buffer-invisibility-spec nil)))
+
 ;; Minibuffer prompt stuff.
 
 ;(defun minibuffer-prompt-modification (start end)
@@ -4455,4 +4531,6 @@ See also `normal-erase-is-backspace'."
 ;
 
 (provide 'simple)
+
+;;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
 ;;; simple.el ends here