X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fsimple.el;h=9ece9ae414a4006fe43e5c4600d61b864cf61345;hb=c0331b23a3bedc76e8ca3aab657ec3774efb9f5b;hp=5b306a1669f8c7842f10c2000756c2b080c5683a;hpb=2fd9701a4f902054649dde9143a3f77809afee8f;p=chise%2Fxemacs-chise.git- diff --git a/lisp/simple.el b/lisp/simple.el index 5b306a1..9ece9ae 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1667,10 +1667,71 @@ store it in a Lisp variable. Example: ; (set-marker (mark-marker) nil))) (defvar mark-ring nil - "The list of former marks of the current buffer, most recent first.") + "The list of former marks of the current buffer, most recent first. +This variable is automatically buffer-local.") (make-variable-buffer-local 'mark-ring) (put 'mark-ring 'permanent-local t) +(defvar dont-record-current-mark nil + "If set to t, the current mark value should not be recorded on the mark ring. +This is set by commands that manipulate the mark incidentally, to avoid +cluttering the mark ring unnecessarily. Under most circumstances, you do +not need to set this directly; it is automatically reset each time +`push-mark' is called, according to `mark-ring-unrecorded-commands'. This +variable is automatically buffer-local.") +(make-variable-buffer-local 'dont-record-current-mark) +(put 'dont-record-current-mark 'permanent-local t) + +;; a conspiracy between push-mark and handle-pre-motion-command +(defvar in-shifted-motion-command nil) + +(defcustom mark-ring-unrecorded-commands '(shifted-motion-commands + yank + mark-beginning-of-buffer + mark-bob + mark-defun + mark-end-of-buffer + mark-end-of-line + mark-end-of-sentence + mark-eob + mark-marker + mark-page + mark-paragraph + mark-sexp + mark-whole-buffer + mark-word) + "*List of commands whose marks should not be recorded on the mark stack. +Many commands set the mark as part of their action. Normally, all such +marks get recorded onto the mark stack. However, this tends to clutter up +the mark stack unnecessarily. You can control this by putting a command +onto this list. Then, any marks set by the function will not be recorded. + +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) + (const :tag "functions that select text" + :inline t + '(mark-beginning-of-buffer + mark-bob + mark-defun + mark-end-of-buffer + mark-end-of-line + mark-end-of-sentence + mark-eob + mark-marker + mark-page + mark-paragraph + mark-sexp + mark-whole-buffer + mark-word)) + (const :tag "functions that paste text" + 'yank) + function)) + :group 'killing) + (defcustom mark-ring-max 16 "*Maximum size of mark ring. Start discarding off end if gets this big." :type 'integer @@ -1692,6 +1753,14 @@ ring, and push mark on global mark ring. With argument, jump to mark, and pop a new position for mark off the ring \(does not affect global mark ring\). +The mark ring is a per-buffer stack of marks, most recent first. Its +maximum length is controlled by `mark-ring-max'. Generally, when new +marks are set, the current mark is pushed onto the stack. You can pop +marks off the stack using \\[universal-argument] \\[set-mark-command]. The term \"ring\" is used because when +you pop a mark off the stack, the current mark value is pushed onto the +far end of the stack. If this is confusing, just think of the mark ring +as a stack. + Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." (interactive "P") @@ -1699,6 +1768,7 @@ purposes. See the documentation of `set-mark' for more information." (push-mark nil nil t) (if (null (mark t)) (error "No mark set in this buffer") + (if dont-record-current-mark (pop-mark)) (goto-char (mark t)) (pop-mark)))) @@ -1713,7 +1783,7 @@ Activate mark if optional third arg ACTIVATE-REGION non-nil. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." (setq buffer (decode-buffer buffer)) ; XEmacs - (if (null (mark t buffer)) ; XEmacs + (if (or dont-record-current-mark (null (mark t buffer))) ; XEmacs nil ;; The save-excursion / set-buffer is necessary because mark-ring ;; is a buffer local variable @@ -1727,8 +1797,9 @@ purposes. See the documentation of `set-mark' for more information." (set-mark (or location (point buffer)) buffer) ; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF ;; Now push the mark on the global mark ring. - (if (or (null global-mark-ring) - (not (eq (marker-buffer (car global-mark-ring)) buffer))) + (if (and (not dont-record-current-mark) + (or (null global-mark-ring) + (not (eq (marker-buffer (car global-mark-ring)) buffer)))) ;; The last global mark pushed wasn't in this same buffer. (progn (setq global-mark-ring (cons (copy-marker (mark-marker t buffer)) @@ -1738,7 +1809,13 @@ purposes. See the documentation of `set-mark' for more information." (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil buffer) (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))) - (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) + (setq dont-record-current-mark + (not (not (or (and in-shifted-motion-command + (memq 'shifted-motion-commands + mark-ring-unrecorded-commands)) + (memq this-command mark-ring-unrecorded-commands))))) + (or dont-record-current-mark nomsg executing-kbd-macro + (> (minibuffer-depth) 0) (display-message 'command "Mark set")) (if activate-region (progn @@ -1877,7 +1954,8 @@ if `shifted-motion-keys-select-region' is nil." shifted-motion-keys-select-region (not (region-active-p)) (memq 'shift (event-modifiers last-input-event))) - (push-mark nil nil t))) + (let ((in-shifted-motion-command t)) + (push-mark nil nil t)))) (defun handle-post-motion-command () (if @@ -1923,6 +2001,17 @@ is nil. If BUFFER is nil, the current buffer is assumed." (beginning-of-buffer nil) (end-of-buffer nil)))) +(defun scroll-up-one () + "Scroll text of current window upward one line. +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." + (interactive "_") + (scroll-up-command 1)) + (defun scroll-up-command (&optional n) "Scroll text of current window upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. @@ -1942,6 +2031,17 @@ boundaries do not cause an error to be signaled." (beginning-of-buffer nil) (end-of-buffer nil)))) +(defun scroll-down-one () + "Scroll text of current window downward one line. +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." + (interactive "_") + (scroll-down-command 1)) + (defun scroll-down-command (&optional n) "Scroll text of current window downward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. @@ -3276,6 +3376,10 @@ when it is off screen." element)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; mail composition code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defcustom mail-user-agent 'sendmail-user-agent "*Your preference for a mail composition package. Various Emacs Lisp packages (e.g. reporter) require you to compose an @@ -3421,6 +3525,10 @@ Each action has the form (FUNCTION . ARGS)." 'switch-to-buffer-other-frame yank-action send-actions)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; set variable ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun set-variable (var val) "Set VARIABLE to VALUE. VALUE is a Lisp object. When using this interactively, supply a Lisp expression for VALUE. @@ -3463,31 +3571,11 @@ it were the arg to `interactive' (which see) to interactively read the value." (if (and (boundp var) (specifierp (symbol-value var))) (set-specifier (symbol-value var) val) (set var val))) - -;; XEmacs -(defun activate-region () - "Activate the region, if `zmacs-regions' is true. -Setting `zmacs-regions' to true causes LISPM-style active regions to be used. -This function has no effect if `zmacs-regions' is false." - (interactive) - (and zmacs-regions (zmacs-activate-region))) - -;; XEmacs -(defsubst region-exists-p () - "Return t if the region exists. -If active regions are in use (i.e. `zmacs-regions' is true), this means that - the region is active. Otherwise, this means that the user has pushed - a mark in this buffer at some point in the past. -The functions `region-beginning' and `region-end' can be used to find the - limits of the region." - (not (null (mark)))) -;; XEmacs -(defun region-active-p () - "Return non-nil if the region is active. -If `zmacs-regions' is true, this is equivalent to `region-exists-p'. -Otherwise, this function always returns false." - (and zmacs-regions zmacs-region-extent)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; case changing code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; A bunch of stuff was moved elsewhere: ;; completion-list-mode-map @@ -3565,12 +3653,42 @@ The words not capitalized are specified in `uncapitalized-title-words'." (forward-word 1)) (setq first nil)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; zmacs active region code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Most of the zmacs code is now in elisp. The only thing left in C ;; are the variables zmacs-regions, zmacs-region-active-p and ;; zmacs-region-stays plus the function zmacs_update_region which ;; simply calls the lisp level zmacs-update-region. It must remain ;; for convenience, since it is called by core C code. +;; XEmacs +(defun activate-region () + "Activate the region, if `zmacs-regions' is true. +Setting `zmacs-regions' to true causes LISPM-style active regions to be used. +This function has no effect if `zmacs-regions' is false." + (interactive) + (and zmacs-regions (zmacs-activate-region))) + +;; XEmacs +(defsubst region-exists-p () + "Return t if the region exists. +If active regions are in use (i.e. `zmacs-regions' is true), this means that + the region is active. Otherwise, this means that the user has pushed + a mark in this buffer at some point in the past. +The functions `region-beginning' and `region-end' can be used to find the + limits of the region." + (not (null (mark)))) + +;; XEmacs +(defun region-active-p () + "Return non-nil if the region is active. +If `zmacs-regions' is true, this is equivalent to `region-exists-p'. +Otherwise, this function always returns false." + (and zmacs-regions zmacs-region-extent)) + (defvar zmacs-activate-region-hook nil "Function or functions called when the region becomes active; see the variable `zmacs-regions'.") @@ -3711,9 +3829,10 @@ when appropriate. Calling this function will call the hook (mark-marker t)))) (run-hooks 'zmacs-update-region-hook))) -;;;;;; -;;;;;; echo area stuff -;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; message logging code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; #### Should this be moved to a separate file, for clarity? ;;; -hniksic @@ -4034,10 +4153,10 @@ See `display-message' for a list of standard labels." (display-message label str) str))) - -;;;;;; -;;;;;; warning stuff -;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; warning code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom log-warning-minimum-level 'info "Minimum level of warnings that should be logged. @@ -4239,6 +4358,11 @@ The C code calls this periodically, right before redisplay." (set-window-start (display-buffer buffer) warning-marker)) (set-marker warning-marker (point-max buffer) buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; misc junk ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun emacs-name () "Return the printable name of this instance of Emacs." (cond ((featurep 'infodock) "InfoDock")