(message "Line %d" buffer-line)))))))
(setq zmacs-region-stays t))
-;;; Bob Weiner, Altrasoft, 02/12/1998
-;;; Added the 3rd arg in `count-lines' to conditionalize the counting of
-;;; collapsed lines.
+;; new in XEmacs 21.2 (not in FSF).
+(defun line-number (&optional pos respect-narrowing)
+ "Return the line number of POS (defaults to point).
+If RESPECT-NARROWING is non-nil, then the narrowed line number is returned;
+otherwise, the absolute line number is returned. The returned line can always
+be given to `goto-line' to get back to the current line."
+ (if (and pos (/= pos (point)))
+ (save-excursion
+ (goto-char pos)
+ (line-number nil respect-narrowing))
+ (1+ (count-lines (if respect-narrowing (point-min) 1) (point-at-bol)))))
+
(defun count-lines (start end &optional ignore-invisible-lines-flag)
"Return number of lines between START and END.
This is usually the number of newlines between them,
and the greater of them is not at the start of a line.
With optional IGNORE-INVISIBLE-LINES-FLAG non-nil, lines collapsed with
-selective-display are excluded from the line count."
+selective-display are excluded from the line count.
+
+NOTE: The expression to return the current line number is not obvious:
+
+(1+ (count-lines 1 (point-at-bol)))
+
+See also `line-number'."
(save-excursion
(save-restriction
(narrow-to-region start end)
; (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
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")
(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))))
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
(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))
(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
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
(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.
(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.
(forward-line arg)))
arg))
-(eval-when-compile
- ;; avoid byte-compiler warnings...
- (defvar start1)
- (defvar start2)
- (defvar end1)
- (defvar end2))
+(defun transpose-line-up (arg)
+ "Move current line one line up, leaving point at beginning of that line.
+This can be run repeatedly to move to current line up a number of lines."
+ (interactive "*p")
+ ;; Move forward over a line,
+ ;; but create a newline if none exists yet.
+ (end-of-line)
+ (if (eobp)
+ (newline)
+ (forward-char 1))
+ (transpose-lines (- arg))
+ (forward-line -1))
+
+(defun transpose-line-down (arg)
+ "Move current line one line down, leaving point at beginning of that line.
+This can be run repeatedly to move to current line down a number of lines."
+ (interactive "*p")
+ ;; Move forward over a line,
+ ;; but create a newline if none exists yet.
+ (end-of-line)
+ (if (eobp)
+ (newline)
+ (forward-char 1))
+ (transpose-lines arg)
+ (forward-line -1))
-; start[12] and end[12] used in transpose-subr-1 below
(defun transpose-subr (mover arg)
(let (start1 end1 start2 end2)
- (if (= arg 0)
- (progn
- (save-excursion
- (funcall mover 1)
- (setq end2 (point))
- (funcall mover -1)
- (setq start2 (point))
- (goto-char (mark t)) ; XEmacs
- (funcall mover 1)
- (setq end1 (point))
- (funcall mover -1)
- (setq start1 (point))
- (transpose-subr-1))
- (exchange-point-and-mark t))) ; XEmacs
- (while (> arg 0)
- (funcall mover -1)
- (setq start1 (point))
- (funcall mover 1)
- (setq end1 (point))
- (funcall mover 1)
- (setq end2 (point))
- (funcall mover -1)
- (setq start2 (point))
- (transpose-subr-1)
- (goto-char end2)
- (setq arg (1- arg)))
- (while (< arg 0)
- (funcall mover -1)
- (setq start2 (point))
- (funcall mover -1)
- (setq start1 (point))
- (funcall mover 1)
- (setq end1 (point))
- (funcall mover 1)
- (setq end2 (point))
- (transpose-subr-1)
- (setq arg (1+ arg)))))
-
-; start[12] and end[12] used free
-(defun transpose-subr-1 ()
- (if (> (min end1 end2) (max start1 start2))
- (error "Don't have two things to transpose"))
- (let ((word1 (buffer-substring start1 end1))
- (word2 (buffer-substring start2 end2)))
- (delete-region start2 end2)
- (goto-char start2)
- (insert word1)
- (goto-char (if (< start1 start2) start1
- (+ start1 (- (length word1) (length word2)))))
- (delete-char (length word1))
- (insert word2)))
+ ;; XEmacs -- use flet instead of defining a separate function and
+ ;; relying on dynamic scope!!!
+ (flet ((transpose-subr-1 ()
+ (if (> (min end1 end2) (max start1 start2))
+ (error "Don't have two things to transpose"))
+ (let ((word1 (buffer-substring start1 end1))
+ (word2 (buffer-substring start2 end2)))
+ (delete-region start2 end2)
+ (goto-char start2)
+ (insert word1)
+ (goto-char (if (< start1 start2) start1
+ (+ start1 (- (length word1) (length word2)))))
+ (delete-char (length word1))
+ (insert word2))))
+ (if (= arg 0)
+ (progn
+ (save-excursion
+ (funcall mover 1)
+ (setq end2 (point))
+ (funcall mover -1)
+ (setq start2 (point))
+ (goto-char (mark t)) ; XEmacs
+ (funcall mover 1)
+ (setq end1 (point))
+ (funcall mover -1)
+ (setq start1 (point))
+ (transpose-subr-1))
+ (exchange-point-and-mark t))) ; XEmacs
+ (while (> arg 0)
+ (funcall mover -1)
+ (setq start1 (point))
+ (funcall mover 1)
+ (setq end1 (point))
+ (funcall mover 1)
+ (setq end2 (point))
+ (funcall mover -1)
+ (setq start2 (point))
+ (transpose-subr-1)
+ (goto-char end2)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (funcall mover -1)
+ (setq start2 (point))
+ (funcall mover -1)
+ (setq start1 (point))
+ (funcall mover 1)
+ (setq end1 (point))
+ (funcall mover 1)
+ (setq end2 (point))
+ (transpose-subr-1)
+ (setq arg (1+ arg))))))
+
\f
(defcustom comment-column 32
"*Column to indent right-margin comments to.
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
\f
-(eval-when-compile (defvar myhelp)) ; suppress compiler warning
;; XEmacs: Some functions moved to cmdloop.el:
;; keyboard-quit
element))
\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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
'switch-to-buffer-other-frame yank-action send-actions))
\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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.
(let* ((var (read-variable "Set variable: "))
;; #### - yucky code replication here. This should use something
;; from help.el or hyper-apropos.el
- (minibuffer-help-form
- '(funcall myhelp))
(myhelp
#'(lambda ()
(with-output-to-temp-buffer "*Help*"
(save-excursion
(set-buffer standard-output)
(help-mode))
- nil))))
+ nil)))
+ (minibuffer-help-form
+ '(funcall myhelp)))
(list var
(let ((prop (get var 'variable-interactive)))
(if prop
(if (and (boundp var) (specifierp (symbol-value var)))
(set-specifier (symbol-value var) val)
(set var val)))
-\f
-;; 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))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; case changing code ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A bunch of stuff was moved elsewhere:
;; completion-list-mode-map
(forward-word 1))
(setq first nil))))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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'.")
(mark-marker t))))
(run-hooks 'zmacs-update-region-hook)))
-;;;;;;
-;;;;;; echo area stuff
-;;;;;;
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; message logging code ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; #### Should this be moved to a separate file, for clarity?
;;; -hniksic
(display-message label str)
str)))
-
-;;;;;;
-;;;;;; warning stuff
-;;;;;;
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; warning code ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom log-warning-minimum-level 'info
"Minimum level of warnings that should be logged.
(setq warning-marker (make-marker))
(set-marker warning-marker 1 buffer))
(if temp-buffer-show-function
- (let ((show-buffer (get-buffer-create "*Warnings-Show*")))
- (save-excursion
- (set-buffer show-buffer)
- (setq buffer-read-only nil)
- (erase-buffer))
- (save-excursion
- (set-buffer buffer)
- (copy-to-buffer show-buffer
- (marker-position warning-marker)
- (point-max)))
- (funcall temp-buffer-show-function show-buffer))
+ (progn
+ (funcall temp-buffer-show-function buffer)
+ (mapc #'(lambda (win) (set-window-start win warning-marker))
+ (windows-of-buffer buffer nil t)))
(set-window-start (display-buffer buffer) warning-marker))
(set-marker warning-marker (point-max buffer) buffer)))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; misc junk ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(defun emacs-name ()
"Return the printable name of this instance of Emacs."
(cond ((featurep 'infodock) "InfoDock")
((featurep 'xemacs) "XEmacs")
(t "Emacs")))
+
+(defun debug-print (format &rest args)
+ "Send a string to the debugging output.
+The string is formatted using (apply #'format FORMAT ARGS)."
+ (princ (apply #'format format args) 'external-debugging-output))
;;; simple.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff