LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - lisp.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 367 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 28 0.0 %

          Line data    Source code
       1             : ;;; lisp.el --- Lisp editing commands for Emacs  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1985-1986, 1994, 2000-2017 Free Software Foundation,
       4             : ;; Inc.
       5             : 
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: lisp, languages
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; Lisp editing commands to go with Lisp major mode.  More-or-less
      28             : ;; applicable in other modes too.
      29             : 
      30             : ;;; Code:
      31             : 
      32             : ;; Note that this variable is used by non-lisp modes too.
      33             : (defcustom defun-prompt-regexp nil
      34             :   "If non-nil, a regexp to ignore before a defun.
      35             : This is only necessary if the opening paren or brace is not in column 0.
      36             : See function `beginning-of-defun'."
      37             :   :type '(choice (const nil)
      38             :                  regexp)
      39             :   :group 'lisp)
      40             : (make-variable-buffer-local 'defun-prompt-regexp)
      41             : 
      42             : (defcustom parens-require-spaces t
      43             :   "If non-nil, add whitespace as needed when inserting parentheses.
      44             : This affects `insert-parentheses' and `insert-pair'."
      45             :   :type 'boolean
      46             :   :group 'lisp)
      47             : 
      48             : (defvar forward-sexp-function nil
      49             :   ;; FIXME:
      50             :   ;; - for some uses, we may want a "sexp-only" version, which only
      51             :   ;;   jumps over a well-formed sexp, rather than some dwimish thing
      52             :   ;;   like jumping from an "else" back up to its "if".
      53             :   ;; - for up-list, we could use the "sexp-only" behavior as well
      54             :   ;;   to treat the dwimish halfsexp as a form of "up-list" step.
      55             :   "If non-nil, `forward-sexp' delegates to this function.
      56             : Should take the same arguments and behave similarly to `forward-sexp'.")
      57             : 
      58             : (defun forward-sexp (&optional arg)
      59             :   "Move forward across one balanced expression (sexp).
      60             : With ARG, do it that many times.  Negative arg -N means move
      61             : backward across N balanced expressions.  This command assumes
      62             : point is not in a string or comment.  Calls
      63             : `forward-sexp-function' to do the work, if that is non-nil.  If
      64             : unable to move over a sexp, signal `scan-error' with three
      65             : arguments: a message, the start of the obstacle (usually a
      66             : parenthesis or list marker of some kind), and end of the
      67             : obstacle."
      68             :   (interactive "^p")
      69           0 :   (or arg (setq arg 1))
      70           0 :   (if forward-sexp-function
      71           0 :       (funcall forward-sexp-function arg)
      72           0 :     (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
      73           0 :     (if (< arg 0) (backward-prefix-chars))))
      74             : 
      75             : (defun backward-sexp (&optional arg)
      76             :   "Move backward across one balanced expression (sexp).
      77             : With ARG, do it that many times.  Negative arg -N means
      78             : move forward across N balanced expressions.
      79             : This command assumes point is not in a string or comment.
      80             : Uses `forward-sexp' to do the work."
      81             :   (interactive "^p")
      82           0 :   (or arg (setq arg 1))
      83           0 :   (forward-sexp (- arg)))
      84             : 
      85             : (defun mark-sexp (&optional arg allow-extend)
      86             :   "Set mark ARG sexps from point.
      87             : The place mark goes is the same place \\[forward-sexp] would
      88             : move to with the same argument.
      89             : Interactively, if this command is repeated
      90             : or (in Transient Mark mode) if the mark is active,
      91             : it marks the next ARG sexps after the ones already marked.
      92             : This command assumes point is not in a string or comment."
      93             :   (interactive "P\np")
      94           0 :   (cond ((and allow-extend
      95           0 :               (or (and (eq last-command this-command) (mark t))
      96           0 :                   (and transient-mark-mode mark-active)))
      97           0 :          (setq arg (if arg (prefix-numeric-value arg)
      98           0 :                      (if (< (mark) (point)) -1 1)))
      99           0 :          (set-mark
     100           0 :           (save-excursion
     101           0 :             (goto-char (mark))
     102           0 :             (forward-sexp arg)
     103           0 :             (point))))
     104             :         (t
     105           0 :          (push-mark
     106           0 :           (save-excursion
     107           0 :             (forward-sexp (prefix-numeric-value arg))
     108           0 :             (point))
     109           0 :           nil t))))
     110             : 
     111             : (defun forward-list (&optional arg)
     112             :   "Move forward across one balanced group of parentheses.
     113             : This command will also work on other parentheses-like expressions
     114             : defined by the current language mode.
     115             : With ARG, do it that many times.
     116             : Negative arg -N means move backward across N groups of parentheses.
     117             : This command assumes point is not in a string or comment."
     118             :   (interactive "^p")
     119           0 :   (or arg (setq arg 1))
     120           0 :   (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
     121             : 
     122             : (defun backward-list (&optional arg)
     123             :   "Move backward across one balanced group of parentheses.
     124             : This command will also work on other parentheses-like expressions
     125             : defined by the current language mode.
     126             : With ARG, do it that many times.
     127             : Negative arg -N means move forward across N groups of parentheses.
     128             : This command assumes point is not in a string or comment."
     129             :   (interactive "^p")
     130           0 :   (or arg (setq arg 1))
     131           0 :   (forward-list (- arg)))
     132             : 
     133             : (defun down-list (&optional arg)
     134             :   "Move forward down one level of parentheses.
     135             : This command will also work on other parentheses-like expressions
     136             : defined by the current language mode.
     137             : With ARG, do this that many times.
     138             : A negative argument means move backward but still go down a level.
     139             : This command assumes point is not in a string or comment."
     140             :   (interactive "^p")
     141           0 :   (or arg (setq arg 1))
     142           0 :   (let ((inc (if (> arg 0) 1 -1)))
     143           0 :     (while (/= arg 0)
     144           0 :       (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
     145           0 :       (setq arg (- arg inc)))))
     146             : 
     147             : (defun backward-up-list (&optional arg escape-strings no-syntax-crossing)
     148             :   "Move backward out of one level of parentheses.
     149             : This command will also work on other parentheses-like expressions
     150             : defined by the current language mode.  With ARG, do this that
     151             : many times.  A negative argument means move forward but still to
     152             : a less deep spot.  If ESCAPE-STRINGS is non-nil (as it is
     153             : interactively), move out of enclosing strings as well.  If
     154             : NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
     155             : break out of any enclosing string instead of moving to the start
     156             : of a list broken across multiple strings.  On error, location of
     157             : point is unspecified."
     158             :   (interactive "^p\nd\nd")
     159           0 :   (up-list (- (or arg 1)) escape-strings no-syntax-crossing))
     160             : 
     161             : (defun up-list (&optional arg escape-strings no-syntax-crossing)
     162             :   "Move forward out of one level of parentheses.
     163             : This command will also work on other parentheses-like expressions
     164             : defined by the current language mode.  With ARG, do this that
     165             : many times.  A negative argument means move backward but still to
     166             : a less deep spot.  If ESCAPE-STRINGS is non-nil (as it is
     167             : interactively), move out of enclosing strings as well. If
     168             : NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
     169             : break out of any enclosing string instead of moving to the start
     170             : of a list broken across multiple strings.  On error, location of
     171             : point is unspecified."
     172             :   (interactive "^p\nd\nd")
     173           0 :   (or arg (setq arg 1))
     174           0 :   (let ((inc (if (> arg 0) 1 -1))
     175             :         (pos nil))
     176           0 :     (while (/= arg 0)
     177           0 :       (condition-case err
     178           0 :           (save-restriction
     179             :             ;; If we've been asked not to cross string boundaries
     180             :             ;; and we're inside a string, narrow to that string so
     181             :             ;; that scan-lists doesn't find a match in a different
     182             :             ;; string.
     183           0 :             (when no-syntax-crossing
     184           0 :               (let* ((syntax (syntax-ppss))
     185           0 :                      (string-comment-start (nth 8 syntax)))
     186           0 :                 (when string-comment-start
     187           0 :                   (save-excursion
     188           0 :                     (goto-char string-comment-start)
     189           0 :                     (narrow-to-region
     190           0 :                      (point)
     191           0 :                      (if (nth 3 syntax) ; in string
     192           0 :                          (condition-case nil
     193           0 :                              (progn (forward-sexp) (point))
     194           0 :                            (scan-error (point-max)))
     195           0 :                        (forward-comment 1)
     196           0 :                        (point)))))))
     197           0 :             (if (null forward-sexp-function)
     198           0 :                 (goto-char (or (scan-lists (point) inc 1)
     199           0 :                                (buffer-end arg)))
     200           0 :               (condition-case err
     201           0 :                   (while (progn (setq pos (point))
     202           0 :                                 (forward-sexp inc)
     203           0 :                                 (/= (point) pos)))
     204           0 :                 (scan-error (goto-char (nth (if (> arg 0) 3 2) err))))
     205           0 :               (if (= (point) pos)
     206           0 :                   (signal 'scan-error
     207           0 :                           (list "Unbalanced parentheses" (point) (point))))))
     208             :         (scan-error
     209           0 :          (let ((syntax nil))
     210           0 :            (or
     211             :             ;; If we bumped up against the end of a list, see whether
     212             :             ;; we're inside a string: if so, just go to the beginning
     213             :             ;; or end of that string.
     214           0 :             (and escape-strings
     215           0 :                  (or syntax (setf syntax (syntax-ppss)))
     216           0 :                  (nth 3 syntax)
     217           0 :                  (goto-char (nth 8 syntax))
     218           0 :                  (progn (when (> inc 0)
     219           0 :                           (forward-sexp))
     220           0 :                         t))
     221             :             ;; If we narrowed to a comment above and failed to escape
     222             :             ;; it, the error might be our fault, not an indication
     223             :             ;; that we're out of syntax.  Try again from beginning or
     224             :             ;; end of the comment.
     225           0 :             (and no-syntax-crossing
     226           0 :                  (or syntax (setf syntax (syntax-ppss)))
     227           0 :                  (nth 4 syntax)
     228           0 :                  (goto-char (nth 8 syntax))
     229           0 :                  (or (< inc 0)
     230           0 :                      (forward-comment 1))
     231           0 :                  (setf arg (+ arg inc)))
     232           0 :             (signal (car err) (cdr err))))))
     233           0 :       (setq arg (- arg inc)))))
     234             : 
     235             : (defun kill-sexp (&optional arg)
     236             :   "Kill the sexp (balanced expression) following point.
     237             : With ARG, kill that many sexps after point.
     238             : Negative arg -N means kill N sexps before point.
     239             : This command assumes point is not in a string or comment."
     240             :   (interactive "p")
     241           0 :   (let ((opoint (point)))
     242           0 :     (forward-sexp (or arg 1))
     243           0 :     (kill-region opoint (point))))
     244             : 
     245             : (defun backward-kill-sexp (&optional arg)
     246             :   "Kill the sexp (balanced expression) preceding point.
     247             : With ARG, kill that many sexps before point.
     248             : Negative arg -N means kill N sexps after point.
     249             : This command assumes point is not in a string or comment."
     250             :   (interactive "p")
     251           0 :   (kill-sexp (- (or arg 1))))
     252             : 
     253             : ;; After Zmacs:
     254             : (defun kill-backward-up-list (&optional arg)
     255             :   "Kill the form containing the current sexp, leaving the sexp itself.
     256             : A prefix argument ARG causes the relevant number of surrounding
     257             : forms to be removed.
     258             : This command assumes point is not in a string or comment."
     259             :   (interactive "*p")
     260           0 :   (let ((current-sexp (thing-at-point 'sexp)))
     261           0 :     (if current-sexp
     262           0 :         (save-excursion
     263           0 :           (backward-up-list arg)
     264           0 :           (kill-sexp)
     265           0 :           (insert current-sexp))
     266           0 :       (user-error "Not at a sexp"))))
     267             : 
     268             : (defvar beginning-of-defun-function nil
     269             :   "If non-nil, function for `beginning-of-defun-raw' to call.
     270             : This is used to find the beginning of the defun instead of using the
     271             : normal recipe (see `beginning-of-defun').  Major modes can define this
     272             : if defining `defun-prompt-regexp' is not sufficient to handle the mode's
     273             : needs.
     274             : 
     275             : The function takes the same argument as `beginning-of-defun' and should
     276             : behave similarly, returning non-nil if it found the beginning of a defun.
     277             : Ideally it should move to a point right before an open-paren which encloses
     278             : the body of the defun.")
     279             : 
     280             : (defun beginning-of-defun (&optional arg)
     281             :   "Move backward to the beginning of a defun.
     282             : With ARG, do it that many times.  Negative ARG means move forward
     283             : to the ARGth following beginning of defun.
     284             : 
     285             : If search is successful, return t; point ends up at the beginning
     286             : of the line where the search succeeded.  Otherwise, return nil.
     287             : 
     288             : When `open-paren-in-column-0-is-defun-start' is non-nil, a defun
     289             : is assumed to start where there is a char with open-parenthesis
     290             : syntax at the beginning of a line.  If `defun-prompt-regexp' is
     291             : non-nil, then a string which matches that regexp may also precede
     292             : the open-parenthesis.  If `defun-prompt-regexp' and
     293             : `open-paren-in-column-0-is-defun-start' are both nil, this
     294             : function instead finds an open-paren at the outermost level.
     295             : 
     296             : If the variable `beginning-of-defun-function' is non-nil, its
     297             : value is called as a function, with argument ARG, to find the
     298             : defun's beginning.
     299             : 
     300             : Regardless of the values of `defun-prompt-regexp' and
     301             : `beginning-of-defun-function', point always moves to the
     302             : beginning of the line whenever the search is successful."
     303             :   (interactive "^p")
     304           0 :   (or (not (eq this-command 'beginning-of-defun))
     305           0 :       (eq last-command 'beginning-of-defun)
     306           0 :       (and transient-mark-mode mark-active)
     307           0 :       (push-mark))
     308           0 :   (and (beginning-of-defun-raw arg)
     309           0 :        (progn (beginning-of-line) t)))
     310             : 
     311             : (defun beginning-of-defun-raw (&optional arg)
     312             :   "Move point to the character that starts a defun.
     313             : This is identical to function `beginning-of-defun', except that point
     314             : does not move to the beginning of the line when `defun-prompt-regexp'
     315             : is non-nil.
     316             : 
     317             : If variable `beginning-of-defun-function' is non-nil, its value
     318             : is called as a function to find the defun's beginning."
     319             :   (interactive "^p")   ; change this to "P", maybe, if we ever come to pass ARG
     320             :                       ; to beginning-of-defun-function.
     321           0 :   (unless arg (setq arg 1))
     322           0 :   (cond
     323           0 :    (beginning-of-defun-function
     324           0 :     (condition-case nil
     325           0 :         (funcall beginning-of-defun-function arg)
     326             :       ;; We used to define beginning-of-defun-function as taking no argument
     327             :       ;; but that makes it impossible to implement correct forward motion:
     328             :       ;; we used to use end-of-defun for that, but it's not supposed to do
     329             :       ;; the same thing (it moves to the end of a defun not to the beginning
     330             :       ;; of the next).
     331             :       ;; In case the beginning-of-defun-function uses the old calling
     332             :       ;; convention, fallback on the old implementation.
     333             :       (wrong-number-of-arguments
     334           0 :        (if (> arg 0)
     335           0 :            (dotimes (_ arg)
     336           0 :              (funcall beginning-of-defun-function))
     337           0 :          (dotimes (_ (- arg))
     338           0 :            (funcall end-of-defun-function))))))
     339             : 
     340           0 :    ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
     341           0 :     (and (< arg 0) (not (eobp)) (forward-char 1))
     342           0 :     (and (re-search-backward (if defun-prompt-regexp
     343           0 :                                  (concat (if open-paren-in-column-0-is-defun-start
     344           0 :                                              "^\\s(\\|" "")
     345           0 :                                          "\\(?:" defun-prompt-regexp "\\)\\s(")
     346           0 :                                "^\\s(")
     347           0 :                              nil 'move arg)
     348           0 :          (progn (goto-char (1- (match-end 0)))
     349           0 :                 t)))
     350             : 
     351             :    ;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp
     352             :    ;; are both nil, column 0 has no significance - so scan forward
     353             :    ;; from BOB to see how nested point is, then carry on from there.
     354             :    ;;
     355             :    ;; It is generally not a good idea to land up here, because the
     356             :    ;; call to scan-lists below can be extremely slow.  This is because
     357             :    ;; back_comment in syntax.c may have to scan from bob to find the
     358             :    ;; beginning of each comment.  Fixing this is not trivial -- cyd.
     359             : 
     360           0 :    ((eq arg 0))
     361             :    (t
     362           0 :     (let ((floor (point-min))
     363           0 :           (ceiling (point-max))
     364           0 :           (arg-+ve (> arg 0)))
     365           0 :       (save-restriction
     366           0 :         (widen)
     367           0 :         (let ((ppss (let (syntax-begin-function)
     368           0 :                       (syntax-ppss)))
     369             :               ;; position of least enclosing paren, or nil.
     370             :               encl-pos)
     371             :           ;; Back out of any comment/string, so that encl-pos will always
     372             :           ;; become nil if we're at top-level.
     373           0 :           (when (nth 8 ppss)
     374           0 :             (goto-char (nth 8 ppss))
     375           0 :             (setq ppss (syntax-ppss)))  ; should be fast, due to cache.
     376           0 :           (setq encl-pos (syntax-ppss-toplevel-pos ppss))
     377           0 :           (if encl-pos (goto-char encl-pos))
     378             : 
     379           0 :           (and encl-pos arg-+ve (setq arg (1- arg)))
     380           0 :           (and (not encl-pos) (not arg-+ve) (not (looking-at "\\s("))
     381           0 :                (setq arg (1+ arg)))
     382             : 
     383           0 :           (condition-case nil   ; to catch crazy parens.
     384           0 :               (progn
     385           0 :                 (goto-char (scan-lists (point) (- arg) 0))
     386           0 :                 (if arg-+ve
     387           0 :                     (if (>= (point) floor)
     388             :                         t
     389           0 :                       (goto-char floor)
     390           0 :                       nil)
     391             :                   ;; forward to next (, or trigger the c-c
     392           0 :                   (goto-char (1- (scan-lists (point) 1 -1)))
     393           0 :                   (if (<= (point) ceiling)
     394             :                       t
     395           0 :                     (goto-char ceiling)
     396           0 :                     nil)))
     397             :             (error
     398           0 :              (goto-char (if arg-+ve floor ceiling))
     399           0 :              nil))))))))
     400             : 
     401             : (defun beginning-of-defun--in-emptyish-line-p ()
     402             :   "Return non-nil if the point is in an \"emptyish\" line.
     403             : This means a line that consists entirely of comments and/or
     404             : whitespace."
     405             : ;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html
     406           0 :   (save-excursion
     407           0 :     (forward-line 0)
     408           0 :     (< (line-end-position)
     409           0 :        (let ((ppss (syntax-ppss)))
     410           0 :          (when (nth 4 ppss)
     411           0 :            (goto-char (nth 8 ppss)))
     412           0 :          (forward-comment (point-max))
     413           0 :          (point)))))
     414             : 
     415             : (defun beginning-of-defun-comments (&optional arg)
     416             :   "Move to the beginning of ARGth defun, including comments."
     417             :   (interactive "^p")
     418           0 :   (unless arg (setq arg 1))
     419           0 :   (beginning-of-defun arg)
     420           0 :   (let (first-line-p)
     421           0 :     (while (let ((ppss (progn (setq first-line-p (= (forward-line -1) -1))
     422           0 :                               (syntax-ppss (line-end-position)))))
     423           0 :              (while (and (nth 4 ppss) ; If eol is in a line-spanning comment,
     424           0 :                          (< (nth 8 ppss) (line-beginning-position)))
     425           0 :                (goto-char (nth 8 ppss)) ; skip to comment start.
     426           0 :                (setq ppss (syntax-ppss (line-end-position))))
     427           0 :              (and (not first-line-p)
     428           0 :                   (progn (skip-syntax-backward
     429           0 :                           "-" (line-beginning-position))
     430           0 :                          (not (bolp))) ; Check for blank line.
     431           0 :                   (progn (parse-partial-sexp
     432           0 :                           (line-beginning-position) (line-end-position)
     433           0 :                           nil t (syntax-ppss (line-beginning-position)))
     434           0 :                          (eolp))))) ; Check for non-comment text.
     435           0 :     (forward-line (if first-line-p 0 1))))
     436             : 
     437             : (defvar end-of-defun-function
     438             :   (lambda () (forward-sexp 1))
     439             :   "Function for `end-of-defun' to call.
     440             : This is used to find the end of the defun at point.
     441             : It is called with no argument, right after calling `beginning-of-defun-raw'.
     442             : So the function can assume that point is at the beginning of the defun body.
     443             : It should move point to the first position after the defun.")
     444             : 
     445             : (defun buffer-end (arg)
     446             :   "Return the \"far end\" position of the buffer, in direction ARG.
     447             : If ARG is positive, that's the end of the buffer.
     448             : Otherwise, that's the beginning of the buffer."
     449           0 :   (if (> arg 0) (point-max) (point-min)))
     450             : 
     451             : (defun end-of-defun (&optional arg)
     452             :   "Move forward to next end of defun.
     453             : With argument, do it that many times.
     454             : Negative argument -N means move back to Nth preceding end of defun.
     455             : 
     456             : An end of a defun occurs right after the close-parenthesis that
     457             : matches the open-parenthesis that starts a defun; see function
     458             : `beginning-of-defun'.
     459             : 
     460             : If variable `end-of-defun-function' is non-nil, its value
     461             : is called as a function to find the defun's end."
     462             :   (interactive "^p")
     463           0 :   (or (not (eq this-command 'end-of-defun))
     464           0 :       (eq last-command 'end-of-defun)
     465           0 :       (and transient-mark-mode mark-active)
     466           0 :       (push-mark))
     467           0 :   (if (or (null arg) (= arg 0)) (setq arg 1))
     468           0 :   (let ((pos (point))
     469           0 :         (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
     470             :         (skip (lambda ()
     471             :                 ;; When comparing point against pos, we want to consider that if
     472             :                 ;; point was right after the end of the function, it's still
     473             :                 ;; considered as "in that function".
     474             :                 ;; E.g. `eval-defun' from right after the last close-paren.
     475           0 :                 (unless (bolp)
     476           0 :                   (skip-chars-forward " \t")
     477           0 :                   (if (looking-at "\\s<\\|\n")
     478           0 :                       (forward-line 1))))))
     479           0 :     (funcall end-of-defun-function)
     480           0 :     (funcall skip)
     481           0 :     (cond
     482           0 :      ((> arg 0)
     483             :       ;; Moving forward.
     484           0 :       (if (> (point) pos)
     485             :           ;; We already moved forward by one because we started from
     486             :           ;; within a function.
     487           0 :           (setq arg (1- arg))
     488             :         ;; We started from after the end of the previous function.
     489           0 :         (goto-char pos))
     490           0 :       (unless (zerop arg)
     491           0 :         (beginning-of-defun-raw (- arg))
     492           0 :         (funcall end-of-defun-function)))
     493           0 :      ((< arg 0)
     494             :       ;; Moving backward.
     495           0 :       (if (< (point) pos)
     496             :           ;; We already moved backward because we started from between
     497             :           ;; two functions.
     498           0 :           (setq arg (1+ arg))
     499             :         ;; We started from inside a function.
     500           0 :         (goto-char beg))
     501           0 :       (unless (zerop arg)
     502           0 :         (beginning-of-defun-raw (- arg))
     503           0 :         (setq beg (point))
     504           0 :         (funcall end-of-defun-function))))
     505           0 :     (funcall skip)
     506           0 :     (while (and (< arg 0) (>= (point) pos))
     507             :       ;; We intended to move backward, but this ended up not doing so:
     508             :       ;; Try harder!
     509           0 :       (goto-char beg)
     510           0 :       (beginning-of-defun-raw (- arg))
     511           0 :       (if (>= (point) beg)
     512           0 :           (setq arg 0)
     513           0 :         (setq beg (point))
     514           0 :         (funcall end-of-defun-function)
     515           0 :         (funcall skip)))))
     516             : 
     517             : (defun mark-defun (&optional arg)
     518             :   "Put mark at end of this defun, point at beginning.
     519             : The defun marked is the one that contains point or follows point.
     520             : With positive ARG, mark this and that many next defuns; with negative
     521             : ARG, change the direction of marking.
     522             : 
     523             : If the mark is active, it marks the next or previous defun(s) after
     524             : the one(s) already marked."
     525             :   (interactive "p")
     526           0 :   (setq arg (or arg 1))
     527             :   ;; There is no `mark-defun-back' function - see
     528             :   ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-11/msg00079.html
     529             :   ;; for explanation
     530           0 :   (when (eq last-command 'mark-defun-back)
     531           0 :     (setq arg (- arg)))
     532           0 :   (when (< arg 0)
     533           0 :     (setq this-command 'mark-defun-back))
     534           0 :   (cond ((use-region-p)
     535           0 :          (if (>= arg 0)
     536           0 :              (set-mark
     537           0 :               (save-excursion
     538           0 :                 (goto-char (mark))
     539             :                 ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
     540           0 :                 (dotimes (_ignore arg)
     541           0 :                   (end-of-defun))
     542           0 :                 (point)))
     543           0 :            (beginning-of-defun-comments (- arg))))
     544             :         (t
     545           0 :          (let ((opoint (point))
     546             :                beg end)
     547           0 :            (push-mark opoint)
     548             :            ;; Try first in this order for the sake of languages with nested
     549             :            ;; functions where several can end at the same place as with the
     550             :            ;; offside rule, e.g. Python.
     551           0 :            (beginning-of-defun-comments)
     552           0 :            (setq beg (point))
     553           0 :            (end-of-defun)
     554           0 :            (setq end (point))
     555           0 :            (when (or (and (<= (point) opoint)
     556           0 :                           (> arg 0))
     557           0 :                      (= beg (point-min))) ; we were before the first defun!
     558             :              ;; beginning-of-defun moved back one defun so we got the wrong
     559             :              ;; one.  If ARG < 0, however, we actually want to go back.
     560           0 :              (goto-char opoint)
     561           0 :              (end-of-defun)
     562           0 :              (setq end (point))
     563           0 :              (beginning-of-defun-comments)
     564           0 :              (setq beg (point)))
     565           0 :            (goto-char beg)
     566           0 :            (cond ((> arg 0)
     567             :                   ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
     568           0 :                   (dotimes (_ignore arg)
     569           0 :                     (end-of-defun))
     570           0 :                   (setq end (point))
     571           0 :                   (push-mark end nil t)
     572           0 :                   (goto-char beg))
     573             :                  (t
     574           0 :                   (goto-char beg)
     575           0 :                   (unless (= arg -1)    ; beginning-of-defun behaves
     576             :                                         ; strange with zero arg - see
     577             :                                         ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html
     578           0 :                     (beginning-of-defun (1- (- arg))))
     579           0 :                   (push-mark end nil t))))))
     580           0 :   (skip-chars-backward "[:space:]\n")
     581           0 :   (unless (bobp)
     582           0 :     (forward-line 1)))
     583             : 
     584             : (defvar narrow-to-defun-include-comments nil
     585             :   "If non-nil, `narrow-to-defun' will also show comments preceding the defun.")
     586             : 
     587             : (defun narrow-to-defun (&optional include-comments)
     588             :   "Make text outside current defun invisible.
     589             : The current defun is the one that contains point or follows point.
     590             : Preceding comments are included if INCLUDE-COMMENTS is non-nil.
     591             : Interactively, the behavior depends on `narrow-to-defun-include-comments'."
     592           0 :   (interactive (list narrow-to-defun-include-comments))
     593           0 :   (save-excursion
     594           0 :     (widen)
     595           0 :     (let ((opoint (point))
     596             :           beg end)
     597             :       ;; Try first in this order for the sake of languages with nested
     598             :       ;; functions where several can end at the same place as with
     599             :       ;; the offside rule, e.g. Python.
     600             : 
     601             :       ;; Finding the start of the function is a bit problematic since
     602             :       ;; `beginning-of-defun' when we are on the first character of
     603             :       ;; the function might go to the previous function.
     604             :       ;;
     605             :       ;; Therefore we first move one character forward and then call
     606             :       ;; `beginning-of-defun'.  However now we must check that we did
     607             :       ;; not move into the next function.
     608           0 :       (let ((here (point)))
     609           0 :         (unless (eolp)
     610           0 :           (forward-char))
     611           0 :         (beginning-of-defun)
     612           0 :         (when (< (point) here)
     613           0 :           (goto-char here)
     614           0 :           (beginning-of-defun)))
     615           0 :       (setq beg (point))
     616           0 :       (end-of-defun)
     617           0 :       (setq end (point))
     618           0 :       (while (looking-at "^\n")
     619           0 :         (forward-line 1))
     620           0 :       (unless (> (point) opoint)
     621             :         ;; beginning-of-defun moved back one defun
     622             :         ;; so we got the wrong one.
     623           0 :         (goto-char opoint)
     624           0 :         (end-of-defun)
     625           0 :         (setq end (point))
     626           0 :         (beginning-of-defun)
     627           0 :         (setq beg (point)))
     628           0 :       (when include-comments
     629           0 :         (goto-char beg)
     630             :         ;; Move back past all preceding comments (and whitespace).
     631           0 :         (when (forward-comment -1)
     632           0 :           (while (forward-comment -1))
     633             :           ;; Move forwards past any page breaks within these comments.
     634           0 :           (when (and page-delimiter (not (string= page-delimiter "")))
     635           0 :             (while (re-search-forward page-delimiter beg t)))
     636             :           ;; Lastly, move past any empty lines.
     637           0 :           (skip-chars-forward "[:space:]\n")
     638           0 :           (beginning-of-line)
     639           0 :           (setq beg (point))))
     640           0 :       (goto-char end)
     641           0 :       (re-search-backward "^\n" (- (point) 1) t)
     642           0 :       (narrow-to-region beg end))))
     643             : 
     644             : (defvar insert-pair-alist
     645             :   '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
     646             :   "Alist of paired characters inserted by `insert-pair'.
     647             : Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
     648             : OPEN-CHAR CLOSE-CHAR).  The characters OPEN-CHAR and CLOSE-CHAR
     649             : of the pair whose key is equal to the last input character with
     650             : or without modifiers, are inserted by `insert-pair'.
     651             : 
     652             : If COMMAND-CHAR is specified, it is a character that triggers the
     653             : insertion of the open/close pair, and COMMAND-CHAR itself isn't
     654             : inserted.")
     655             : 
     656             : (defun insert-pair (&optional arg open close)
     657             :   "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
     658             : Leave point after the first character.
     659             : A negative ARG encloses the preceding ARG sexps instead.
     660             : No argument is equivalent to zero: just insert characters
     661             : and leave point between.
     662             : If `parens-require-spaces' is non-nil, this command also inserts a space
     663             : before and after, depending on the surrounding characters.
     664             : If region is active, insert enclosing characters at region boundaries.
     665             : 
     666             : If arguments OPEN and CLOSE are nil, the character pair is found
     667             : from the variable `insert-pair-alist' according to the last input
     668             : character with or without modifiers.  If no character pair is
     669             : found in the variable `insert-pair-alist', then the last input
     670             : character is inserted ARG times.
     671             : 
     672             : This command assumes point is not in a string or comment."
     673             :   (interactive "P")
     674           0 :   (if (not (and open close))
     675           0 :       (let ((pair (or (assq last-command-event insert-pair-alist)
     676           0 :                       (assq (event-basic-type last-command-event)
     677           0 :                             insert-pair-alist))))
     678           0 :         (if pair
     679           0 :             (if (nth 2 pair)
     680           0 :                 (setq open (nth 1 pair) close (nth 2 pair))
     681           0 :               (setq open (nth 0 pair) close (nth 1 pair))))))
     682           0 :   (if (and open close)
     683           0 :       (if (and transient-mark-mode mark-active)
     684           0 :           (progn
     685           0 :             (save-excursion
     686           0 :               (goto-char (region-end))
     687           0 :               (insert close))
     688           0 :             (goto-char (region-beginning))
     689           0 :             (insert open))
     690           0 :         (if arg (setq arg (prefix-numeric-value arg))
     691           0 :           (setq arg 0))
     692           0 :         (cond ((> arg 0) (skip-chars-forward " \t"))
     693           0 :               ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
     694           0 :         (and parens-require-spaces
     695           0 :              (not (bobp))
     696           0 :              (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
     697           0 :              (insert " "))
     698           0 :         (insert open)
     699           0 :         (save-excursion
     700           0 :           (or (eq arg 0) (forward-sexp arg))
     701           0 :           (insert close)
     702           0 :           (and parens-require-spaces
     703           0 :                (not (eobp))
     704           0 :                (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
     705           0 :                (insert " "))))
     706           0 :     (insert-char (event-basic-type last-command-event)
     707           0 :                  (prefix-numeric-value arg))))
     708             : 
     709             : (defun insert-parentheses (&optional arg)
     710             :   "Enclose following ARG sexps in parentheses.
     711             : Leave point after open-paren.
     712             : A negative ARG encloses the preceding ARG sexps instead.
     713             : No argument is equivalent to zero: just insert `()' and leave point between.
     714             : If `parens-require-spaces' is non-nil, this command also inserts a space
     715             : before and after, depending on the surrounding characters.
     716             : If region is active, insert enclosing characters at region boundaries.
     717             : 
     718             : This command assumes point is not in a string or comment."
     719             :   (interactive "P")
     720           0 :   (insert-pair arg ?\( ?\)))
     721             : 
     722             : (defun delete-pair ()
     723             :   "Delete a pair of characters enclosing the sexp that follows point."
     724             :   (interactive)
     725           0 :   (save-excursion (forward-sexp 1) (delete-char -1))
     726           0 :   (delete-char 1))
     727             : 
     728             : (defun raise-sexp (&optional arg)
     729             :   "Raise ARG sexps higher up the tree."
     730             :   (interactive "p")
     731           0 :   (let ((s (if (and transient-mark-mode mark-active)
     732           0 :                (buffer-substring (region-beginning) (region-end))
     733           0 :              (buffer-substring
     734           0 :               (point)
     735           0 :               (save-excursion (forward-sexp arg) (point))))))
     736           0 :     (backward-up-list 1)
     737           0 :     (delete-region (point) (save-excursion (forward-sexp 1) (point)))
     738           0 :     (save-excursion (insert s))))
     739             : 
     740             : (defun move-past-close-and-reindent ()
     741             :   "Move past next `)', delete indentation before it, then indent after it."
     742             :   (interactive)
     743           0 :   (up-list 1)
     744           0 :   (forward-char -1)
     745           0 :   (while (save-excursion                ; this is my contribution
     746           0 :            (let ((before-paren (point)))
     747           0 :              (back-to-indentation)
     748           0 :              (and (= (point) before-paren)
     749           0 :                   (progn
     750             :                     ;; Move to end of previous line.
     751           0 :                     (beginning-of-line)
     752           0 :                     (forward-char -1)
     753             :                     ;; Verify it doesn't end within a string or comment.
     754           0 :                     (let ((end (point))
     755             :                           state)
     756           0 :                       (beginning-of-line)
     757             :                       ;; Get state at start of line.
     758           0 :                       (setq state  (list 0 nil nil
     759           0 :                                          (null (calculate-lisp-indent))
     760             :                                          nil nil nil nil
     761           0 :                                          nil))
     762             :                       ;; Parse state across the line to get state at end.
     763           0 :                       (setq state (parse-partial-sexp (point) end nil nil
     764           0 :                                                       state))
     765             :                       ;; Check not in string or comment.
     766           0 :                       (and (not (elt state 3)) (not (elt state 4))))))))
     767           0 :     (delete-indentation))
     768           0 :   (forward-char 1)
     769           0 :   (newline-and-indent))
     770             : 
     771             : (defun check-parens ()                  ; lame name?
     772             :   "Check for unbalanced parentheses in the current buffer.
     773             : More accurately, check the narrowed part of the buffer for unbalanced
     774             : expressions (\"sexps\") in general.  This is done according to the
     775             : current syntax table and will find unbalanced brackets or quotes as
     776             : appropriate.  (See Info node `(emacs)Parentheses'.)  If imbalance is
     777             : found, an error is signaled and point is left at the first unbalanced
     778             : character."
     779             :   (interactive)
     780           0 :   (condition-case data
     781             :       ;; Buffer can't have more than (point-max) sexps.
     782           0 :       (scan-sexps (point-min) (point-max))
     783           0 :     (scan-error (push-mark)
     784           0 :                 (goto-char (nth 2 data))
     785             :                 ;; Could print (nth 1 data), which is either
     786             :                 ;; "Containing expression ends prematurely" or
     787             :                 ;; "Unbalanced parentheses", but those may not be so
     788             :                 ;; accurate/helpful, e.g. quotes may actually be
     789             :                 ;; mismatched.
     790           0 :                 (user-error "Unmatched bracket or quote"))))
     791             : 
     792             : (defun field-complete (table &optional predicate)
     793             :   (declare (obsolete completion-in-region "24.4"))
     794           0 :   (let ((minibuffer-completion-table table)
     795           0 :         (minibuffer-completion-predicate predicate)
     796             :         ;; This made sense for lisp-complete-symbol, but for
     797             :         ;; field-complete, this is out of place.  --Stef
     798             :         ;; (completion-annotate-function
     799             :         ;;  (unless (eq predicate 'fboundp)
     800             :         ;;    (lambda (str)
     801             :         ;;      (if (fboundp (intern-soft str)) " <f>"))))
     802             :         )
     803           0 :     (call-interactively 'minibuffer-complete)))
     804             : 
     805             : (defun lisp-complete-symbol (&optional _predicate)
     806             :   "Perform completion on Lisp symbol preceding point.
     807             : Compare that symbol against the known Lisp symbols.
     808             : If no characters can be completed, display a list of possible completions.
     809             : Repeating the command at that point scrolls the list.
     810             : 
     811             : The context determines which symbols are considered.  If the
     812             : symbol starts just after an open-parenthesis, only symbols with
     813             : function definitions are considered.  Otherwise, all symbols with
     814             : function definitions, values or properties are considered."
     815             :   (declare (obsolete completion-at-point "24.4")
     816             :            (advertised-calling-convention () "25.1"))
     817             :   (interactive)
     818           0 :   (let* ((data (elisp-completion-at-point))
     819           0 :          (plist (nthcdr 3 data)))
     820           0 :     (if (null data)
     821           0 :         (minibuffer-message "Nothing to complete")
     822           0 :       (let ((completion-extra-properties plist))
     823           0 :         (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
     824           0 :                               (plist-get plist :predicate))))))
     825             : 
     826             : ;;; lisp.el ends here

Generated by: LCOV version 1.12