(font-lock-turn-off-thing-lock, font-lock-after-fontify-buffer)
[bpt/emacs.git] / lisp / subr.el
index 94ee316..10edc54 100644 (file)
@@ -8,10 +8,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -204,6 +202,11 @@ the return value (nil if RESULT is omitted).
 Treated as a declaration when used at the right place in a
 `defmacro' form.  \(See Info anchor `(elisp)Definition of declare'.)"
   nil)
+
+(defmacro ignore-errors (&rest body)
+  "Execute BODY; if an error occurs, return nil.
+Otherwise, return result of last form in BODY."
+  `(condition-case nil (progn ,@body) (error nil)))
 \f
 ;;;; Basic Lisp functions.
 
@@ -382,14 +385,14 @@ If TEST is omitted or nil, `equal' is used."
       (setq tail (cdr tail)))
     value))
 
-(make-obsolete 'assoc-ignore-case 'assoc-string)
+(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")
 (defun assoc-ignore-case (key alist)
   "Like `assoc', but ignores differences in case and text representation.
 KEY must be a string.  Upper-case and lower-case letters are treated as equal.
 Unibyte strings are converted to multibyte for comparison."
   (assoc-string key alist t))
 
-(make-obsolete 'assoc-ignore-representation 'assoc-string)
+(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")
 (defun assoc-ignore-representation (key alist)
   "Like `assoc', but ignores differences in text representation.
 KEY must be a string.
@@ -828,6 +831,11 @@ in the current Emacs session, then this function may return nil."
   "Return non-nil if OBJECT is a mouse movement event."
   (eq (car-safe object) 'mouse-movement))
 
+(defun mouse-event-p (object)
+  "Return non-nil if OBJECT is a mouse click event."
+  ;; is this really correct? maybe remove mouse-movement?
+  (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
+
 (defsubst event-start (event)
   "Return the starting position of EVENT.
 If EVENT is a mouse or key press or a mouse click, this returns the location
@@ -1041,6 +1049,9 @@ to reread, so it now uses nil to mean `no event', instead of -1."
 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
 (make-obsolete-variable 'x-sent-selection-hooks
                        'x-sent-selection-functions "22.1")
+;; This was introduced in 21.4 for pre-unicode unification and was rendered
+;; obsolete by the use of Unicode internally in 23.1.
+(make-obsolete-variable 'translation-table-for-input nil "23.1")
 
 (defvaralias 'messages-buffer-max-lines 'message-log-max)
 \f
@@ -1487,8 +1498,9 @@ When called from a program, the file name is normaly returned as a
 string.  When run interactively, the argument INTERACTIVE-CALL is t,
 and the file name is displayed in the echo area."
   (interactive (list (completing-read "Locate library: "
-                                     'locate-file-completion
-                                     (cons load-path (get-load-suffixes)))
+                                     (apply-partially
+                                       'locate-file-completion-table
+                                       load-path (get-load-suffixes)))
                     nil nil
                     t))
   (let ((file (locate-file library
@@ -2550,8 +2562,7 @@ See also `with-temp-buffer'."
               (with-current-buffer ,temp-buffer
                 ,@body)
             (with-current-buffer ,temp-buffer
-              (widen)
-              (write-region (point-min) (point-max) ,temp-file nil 0)))
+              (write-region nil nil ,temp-file nil 0)))
         (and (buffer-name ,temp-buffer)
              (kill-buffer ,temp-buffer))))))
 
@@ -2688,92 +2699,6 @@ The value returned is the value of the last form in BODY."
         (with-current-buffer ,old-buffer
           (set-case-table ,old-case-table))))))
 \f
-;;;; Constructing completion tables.
-
-(defun complete-with-action (action table string pred)
-  "Perform completion ACTION.
-STRING is the string to complete.
-TABLE is the completion table, which should not be a function.
-PRED is a completion predicate.
-ACTION can be one of nil, t or `lambda'."
-  ;; (assert (not (functionp table)))
-  (funcall
-   (cond
-    ((null action) 'try-completion)
-    ((eq action t) 'all-completions)
-    (t 'test-completion))
-   string table pred))
-
-(defmacro dynamic-completion-table (fun)
-  "Use function FUN as a dynamic completion table.
-FUN is called with one argument, the string for which completion is required,
-and it should return an alist containing all the intended possible
-completions.  This alist may be a full list of possible completions so that FUN
-can ignore the value of its argument.  If completion is performed in the
-minibuffer, FUN will be called in the buffer from which the minibuffer was
-entered.
-
-The result of the `dynamic-completion-table' form is a function
-that can be used as the ALIST argument to `try-completion' and
-`all-completion'.  See Info node `(elisp)Programmed Completion'."
-  (declare (debug (lambda-expr)))
-  (let ((win (make-symbol "window"))
-        (string (make-symbol "string"))
-        (predicate (make-symbol "predicate"))
-        (mode (make-symbol "mode")))
-    `(lambda (,string ,predicate ,mode)
-       (with-current-buffer (let ((,win (minibuffer-selected-window)))
-                              (if (window-live-p ,win) (window-buffer ,win)
-                                (current-buffer)))
-         (complete-with-action ,mode (,fun ,string) ,string ,predicate)))))
-
-(defmacro lazy-completion-table (var fun)
-  ;; We used to have `&rest args' where `args' were evaluated late (at the
-  ;; time of the call to `fun'), which was counter intuitive.  But to get
-  ;; them to be evaluated early, we have to either use lexical-let (which is
-  ;; not available in subr.el) or use `(lambda (,str) ...) which prevents the use
-  ;; of lexical-let in the callers.
-  ;; So we just removed the argument.  Callers can then simply use either of:
-  ;;   (lazy-completion-table var (lambda () (fun x y)))
-  ;; or
-  ;;   (lazy-completion-table var `(lambda () (fun ',x ',y)))
-  ;; or
-  ;;   (lexical-let ((x x)) ((y y))
-  ;;     (lazy-completion-table var (lambda () (fun x y))))
-  ;; depending on the behavior they want.
-  "Initialize variable VAR as a lazy completion table.
-If the completion table VAR is used for the first time (e.g., by passing VAR
-as an argument to `try-completion'), the function FUN is called with no
-arguments.  FUN must return the completion table that will be stored in VAR.
-If completion is requested in the minibuffer, FUN will be called in the buffer
-from which the minibuffer was entered.  The return value of
-`lazy-completion-table' must be used to initialize the value of VAR.
-
-You should give VAR a non-nil `risky-local-variable' property."
-  (declare (debug (symbol lambda-expr)))
-  (let ((str (make-symbol "string")))
-    `(dynamic-completion-table
-      (lambda (,str)
-        (when (functionp ,var)
-          (setq ,var (,fun)))
-        ,var))))
-
-(defmacro complete-in-turn (a b)
-  "Create a completion table that first tries completion in A and then in B.
-A and B should not be costly (or side-effecting) expressions."
-  (declare (debug (def-form def-form)))
-  `(lambda (string predicate mode)
-     (cond
-      ((eq mode t)
-       (or (all-completions string ,a predicate)
-          (all-completions string ,b predicate)))
-      ((eq mode nil)
-       (or (try-completion string ,a predicate)
-          (try-completion string ,b predicate)))
-      (t
-       (or (test-completion string ,a predicate)
-          (test-completion string ,b predicate))))))
-\f
 ;;; Matching and match data.
 
 (defvar save-match-data-internal)
@@ -2987,10 +2912,11 @@ Modifies the match data; use `save-match-data' if necessary."
 This tries to quote the strings to avoid ambiguity such that
   (split-string-and-unquote (combine-and-quote-strings strs)) == strs
 Only some SEPARATORs will work properly."
-  (let ((sep (or separator " ")))
+  (let* ((sep (or separator " "))
+         (re (concat "[\\\"]" "\\|" (regexp-quote sep))))
     (mapconcat
      (lambda (str)
-       (if (string-match "[\\\"]" str)
+       (if (string-match re str)
           (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
         str))
      strings sep)))