comparison lisp/subr.el @ 77092:055a54275ec3

Fix indentation.

77091:b3589a49ba09

  nil)

;;;; substitute-key-definition and its subroutines.

(defvar key-substitution-in-progress nil
 "Used internally by `substitute-key-definition'.")

(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
  "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
In other words, OLDDEF is replaced with NEWDEF where ever it appears.
Alternatively, if optional fourth argument OLDMAP is specified, we redefine

	(nth 1 position))))

(defun posn-set-point (position)
  "Move point to POSITION.
Select the corresponding window as well."
    (if (not (windowp (posn-window position)))
	(error "Position not in text area of window"))
    (select-window (posn-window position))
    (if (numberp (posn-point position))
	(goto-char (posn-point position))))

(defsubst posn-x-y (position)
  "Return the x and y coordinates in POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."


;;;; Obsolescence declarations for variables, and aliases.

(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
(make-obsolete-variable 'mode-line-inverse-video "use the appropriate faces instead." "21.1")
(make-obsolete-variable 'unread-command-char
  "use `unread-command-events' instead.  That variable is a list of events
to reread, so it now uses nil to mean `no event', instead of -1."
  "before 19.15")

;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
			      "before 19.34")

(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "22.1")
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "22.1")

(defvaralias 'messages-buffer-max-lines 'message-log-max)

;;;; Alternate names for functions - these are not being phased out.

;; open-network-stream is a wrapper around make-network-process.

(when (featurep 'make-network-process)
  (defun open-network-stream (name buffer host service)
  "Open a TCP connection for a service to a host.
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.

Args are NAME BUFFER HOST SERVICE.
NAME is name for process.  It is modified if necessary to make it unique.

 BUFFER may be also nil, meaning that this process is not associated
 with any buffer.
HOST is name of the host to connect to, or its IP address.
SERVICE is name of the service desired, or an integer specifying
 a port number to connect to."
  (make-network-process :name name :buffer buffer
			:host host :service service)))

;; compatibility

(make-obsolete 'process-kill-without-query
               "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
               "22.1")
(defun process-kill-without-query (process &optional flag)
  "Say no query needed if PROCESS is running when Emacs is exited.
Optional second argument if non-nil says to require a query.
Value is t if a query was formerly required."
  (let ((old (process-query-on-exit-flag process)))

(custom-declare-variable-early
 'read-quoted-char-radix 8
 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16."
  :type '(choice (const 8) (const 10) (const 16))
  :group 'editing-basics)

(defun read-quoted-char (&optional prompt)
  "Like `read-char', but do not allow quitting.
Also, if the first character read is an octal digit,
we read any number of octal digits and return the

    ;; If last inserted char has properties, mark them as rear-nonsticky.
    (if (and (> end opoint)
	     (text-properties-at (1- end)))
	(put-text-property (1- end) end 'rear-nonsticky t))

    (if (eq yank-undo-function t)  ;; not set by FUNCTION
	(setq yank-undo-function (nth 3 handler))) ;; UNDO
    (if (nth 4 handler) ;; COMMAND
	(setq this-command (nth 4 handler)))))

(defun insert-buffer-substring-no-properties (buffer &optional start end)
  "Insert before point a substring of BUFFER, without text properties.
BUFFER may be a buffer or a buffer name.

      (if (eq (aref newstr i) fromchar)
	  (aset newstr i tochar)))
    newstr))

(defun replace-regexp-in-string (regexp rep string &optional
                                 fixedcase literal subexp start)
  "Replace all matches for REGEXP with REP in STRING.

Return a new string containing the replacements.

Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the

	(setq matches
	      (cons (replace-match (if (stringp rep)
				       rep
				     (funcall rep (match-string 0 str)))
				   fixedcase literal str subexp)
		    (cons (substring string start mb)       ; unmatched prefix
			  matches)))
	(setq start me))
      ;; Reconstruct a string from the pieces.
      (setq matches (cons (substring string start l) matches)) ; leftover
      (apply #'concat (nreverse matches)))))

	(cons element buffer-invisibility-spec)))

(defun remove-from-invisibility-spec (element)
  "Remove ELEMENT from `buffer-invisibility-spec'."
  (if (consp buffer-invisibility-spec)
    (setq buffer-invisibility-spec (delete element buffer-invisibility-spec))))

;;;; Syntax tables.

(defmacro with-syntax-table (table &rest body)
  "Evaluate BODY with syntax table of current buffer set to TABLE.

Usually the separator is \".\", but it can be any other string.")


(defvar version-regexp-alist
  '(("^[-_+ ]?a\\(lpha\\)?$"   . -3)
    ("^[-_+]$"                 . -3)	; treat "1.2.3-20050920" and "1.2-3" as alpha releases
    ("^[-_+ ]cvs$"             . -3)	; treat "1.2.3-CVS" as alpha release
    ("^[-_+ ]?b\\(eta\\)?$"    . -2)
    ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
  "*Specify association between non-numeric version part and a priority.

  (or (and (stringp ver) (> (length ver) 0))
      (error "Invalid version string: '%s'" ver))
  ;; Change .x.y to 0.x.y
  (if (and (>= (length ver) (length version-separator))
	   (string-equal (substring ver 0 (length version-separator))
		    version-separator))
      (setq ver (concat "0" ver)))
  (save-match-data
    (let ((i 0)
	  (case-fold-search t)		; ignore case in matching
	  lst s al)

77092:055a54275ec3

  nil)

;;;; substitute-key-definition and its subroutines.

(defvar key-substitution-in-progress nil
  "Used internally by `substitute-key-definition'.")

(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
  "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
In other words, OLDDEF is replaced with NEWDEF where ever it appears.
Alternatively, if optional fourth argument OLDMAP is specified, we redefine

	(nth 1 position))))

(defun posn-set-point (position)
  "Move point to POSITION.
Select the corresponding window as well."
  (if (not (windowp (posn-window position)))
      (error "Position not in text area of window"))
  (select-window (posn-window position))
  (if (numberp (posn-point position))
      (goto-char (posn-point position))))

(defsubst posn-x-y (position)
  "Return the x and y coordinates in POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."


;;;; Obsolescence declarations for variables, and aliases.

(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
(make-obsolete-variable
 'mode-line-inverse-video
 "use the appropriate faces instead."
 "21.1")
(make-obsolete-variable
 'unread-command-char
 "use `unread-command-events' instead.  That variable is a list of events
to reread, so it now uses nil to mean `no event', instead of -1."
 "before 19.15")

;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
  "before 19.34")

(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
(make-obsolete-variable 'x-lost-selection-hooks
			'x-lost-selection-functions "22.1")
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
(make-obsolete-variable 'x-sent-selection-hooks
			'x-sent-selection-functions "22.1")

(defvaralias 'messages-buffer-max-lines 'message-log-max)

;;;; Alternate names for functions - these are not being phased out.

;; open-network-stream is a wrapper around make-network-process.

(when (featurep 'make-network-process)
  (defun open-network-stream (name buffer host service)
    "Open a TCP connection for a service to a host.
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.

Args are NAME BUFFER HOST SERVICE.
NAME is name for process.  It is modified if necessary to make it unique.

 BUFFER may be also nil, meaning that this process is not associated
 with any buffer.
HOST is name of the host to connect to, or its IP address.
SERVICE is name of the service desired, or an integer specifying
 a port number to connect to."
    (make-network-process :name name :buffer buffer
				     :host host :service service)))

;; compatibility

(make-obsolete
 'process-kill-without-query
 "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
 "22.1")
(defun process-kill-without-query (process &optional flag)
  "Say no query needed if PROCESS is running when Emacs is exited.
Optional second argument if non-nil says to require a query.
Value is t if a query was formerly required."
  (let ((old (process-query-on-exit-flag process)))

(custom-declare-variable-early
 'read-quoted-char-radix 8
 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16."
 :type '(choice (const 8) (const 10) (const 16))
 :group 'editing-basics)

(defun read-quoted-char (&optional prompt)
  "Like `read-char', but do not allow quitting.
Also, if the first character read is an octal digit,
we read any number of octal digits and return the

    ;; If last inserted char has properties, mark them as rear-nonsticky.
    (if (and (> end opoint)
	     (text-properties-at (1- end)))
	(put-text-property (1- end) end 'rear-nonsticky t))

    (if (eq yank-undo-function t)		   ;; not set by FUNCTION
	(setq yank-undo-function (nth 3 handler))) ;; UNDO
    (if (nth 4 handler)				   ;; COMMAND
	(setq this-command (nth 4 handler)))))

(defun insert-buffer-substring-no-properties (buffer &optional start end)
  "Insert before point a substring of BUFFER, without text properties.
BUFFER may be a buffer or a buffer name.

      (if (eq (aref newstr i) fromchar)
	  (aset newstr i tochar)))
    newstr))

(defun replace-regexp-in-string (regexp rep string &optional
					fixedcase literal subexp start)
  "Replace all matches for REGEXP with REP in STRING.

Return a new string containing the replacements.

Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the

	(setq matches
	      (cons (replace-match (if (stringp rep)
				       rep
				     (funcall rep (match-string 0 str)))
				   fixedcase literal str subexp)
		    (cons (substring string start mb) ; unmatched prefix
			  matches)))
	(setq start me))
      ;; Reconstruct a string from the pieces.
      (setq matches (cons (substring string start l) matches)) ; leftover
      (apply #'concat (nreverse matches)))))

	(cons element buffer-invisibility-spec)))

(defun remove-from-invisibility-spec (element)
  "Remove ELEMENT from `buffer-invisibility-spec'."
  (if (consp buffer-invisibility-spec)
      (setq buffer-invisibility-spec
	    (delete element buffer-invisibility-spec))))

;;;; Syntax tables.

(defmacro with-syntax-table (table &rest body)
  "Evaluate BODY with syntax table of current buffer set to TABLE.

Usually the separator is \".\", but it can be any other string.")


(defvar version-regexp-alist
  '(("^[-_+ ]?a\\(lpha\\)?$"   . -3)
    ("^[-_+]$"                 . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
    ("^[-_+ ]cvs$"             . -3)	; treat "1.2.3-CVS" as alpha release
    ("^[-_+ ]?b\\(eta\\)?$"    . -2)
    ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
  "*Specify association between non-numeric version part and a priority.

  (or (and (stringp ver) (> (length ver) 0))
      (error "Invalid version string: '%s'" ver))
  ;; Change .x.y to 0.x.y
  (if (and (>= (length ver) (length version-separator))
	   (string-equal (substring ver 0 (length version-separator))
			 version-separator))
      (setq ver (concat "0" ver)))
  (save-match-data
    (let ((i 0)
	  (case-fold-search t)		; ignore case in matching
	  lst s al)