dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

er-basic-expansions.el (7529B)


      1 ;;; er-basic-expansions.el --- Words, symbols, strings, et al
      2 
      3 ;; Copyright (C) 2011-2020  Free Software Foundation, Inc
      4 
      5 ;; Author: Magnar Sveen <magnars@gmail.com>
      6 ;; Keywords: marking region
      7 
      8 ;; This program is free software; you can redistribute it and/or modify
      9 ;; it under the terms of the GNU General Public License as published by
     10 ;; the Free Software Foundation, either version 3 of the License, or
     11 ;; (at your option) any later version.
     12 
     13 ;; This program is distributed in the hope that it will be useful,
     14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     16 ;; GNU General Public License for more details.
     17 
     18 ;; You should have received a copy of the GNU General Public License
     19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     20 
     21 ;;; Commentary:
     22 
     23 ;; Expansions that are useful in any major mode.
     24 
     25 ;;; Code:
     26 
     27 (require 'expand-region-core)
     28 
     29 (defun er/mark-word ()
     30   "Mark the entire word around or in front of point."
     31   (interactive)
     32   (let ((word-regexp "\\sw"))
     33     (when (or (looking-at word-regexp)
     34               (er/looking-back-on-line word-regexp))
     35       (skip-syntax-forward "w")
     36       (set-mark (point))
     37       (skip-syntax-backward "w"))))
     38 
     39 (defun er/mark-symbol ()
     40   "Mark the entire symbol around or in front of point."
     41   (interactive)
     42   (let ((symbol-regexp "\\s_\\|\\sw"))
     43     (when (or (looking-at symbol-regexp)
     44               (er/looking-back-on-line symbol-regexp))
     45       (skip-syntax-forward "_w")
     46       (set-mark (point))
     47       (skip-syntax-backward "_w"))))
     48 
     49 (defun er/mark-symbol-with-prefix ()
     50   "Mark the entire symbol around or in front of point, including prefix."
     51   (interactive)
     52   (let ((symbol-regexp "\\s_\\|\\sw")
     53         (prefix-regexp "\\s'"))
     54     (when (or (looking-at prefix-regexp)
     55               (looking-at symbol-regexp)
     56               (er/looking-back-on-line symbol-regexp))
     57       (skip-syntax-forward "'")
     58       (skip-syntax-forward "_w")
     59       (set-mark (point))
     60       (skip-syntax-backward "_w")
     61       (skip-syntax-backward "'"))))
     62 
     63 ;; Mark method call
     64 
     65 (defun er/mark-next-accessor ()
     66   "Presumes that current symbol is already marked, skips over one
     67 period and marks next symbol."
     68   (interactive)
     69   (when (use-region-p)
     70     (when (< (point) (mark))
     71       (exchange-point-and-mark))
     72     (let ((symbol-regexp "\\s_\\|\\sw"))
     73       (when (looking-at "\\.")
     74         (forward-char 1)
     75         (skip-syntax-forward "_w")
     76         (exchange-point-and-mark)))))
     77 
     78 (defun er/mark-method-call ()
     79   "Mark the current symbol (including dots) and then paren to closing paren."
     80   (interactive)
     81   (let ((symbol-regexp "\\(\\s_\\|\\sw\\|\\.\\)+"))
     82     (when (or (looking-at symbol-regexp)
     83               (er/looking-back-on-line symbol-regexp))
     84       (skip-syntax-backward "_w.")
     85       (set-mark (point))
     86       (when (looking-at symbol-regexp)
     87         (goto-char (match-end 0)))
     88       (if (looking-at "(")
     89           (forward-list))
     90       (exchange-point-and-mark))))
     91 
     92 ;; Comments
     93 
     94 (defun er--point-is-in-comment-p ()
     95   "t if point is in comment, otherwise nil"
     96   (or (nth 4 (syntax-ppss))
     97       (memq (get-text-property (point) 'face) '(font-lock-comment-face font-lock-comment-delimiter-face))))
     98 
     99 (defun er/mark-comment ()
    100   "Mark the entire comment around point."
    101   (interactive)
    102   (when (er--point-is-in-comment-p)
    103     (let ((p (point)))
    104       (while (and (er--point-is-in-comment-p) (not (eobp)))
    105         (forward-char 1))
    106       (skip-chars-backward "\n\r")
    107       (set-mark (point))
    108       (goto-char p)
    109       (while (er--point-is-in-comment-p)
    110         (forward-char -1))
    111       (forward-char 1))))
    112 
    113 ;; Quotes
    114 
    115 (defun er--current-quotes-char ()
    116   "The char that is the current quote delimiter"
    117   (nth 3 (syntax-ppss)))
    118 
    119 (defalias 'er--point-inside-string-p 'er--current-quotes-char)
    120 
    121 (defun er--move-point-forward-out-of-string ()
    122   "Move point forward until it exits the current quoted string."
    123   (er--move-point-backward-out-of-string)
    124   (forward-sexp))
    125 
    126 (defun er--move-point-backward-out-of-string ()
    127   "Move point backward until it exits the current quoted string."
    128   (goto-char (nth 8 (syntax-ppss))))
    129 
    130 (defun er/mark-inside-quotes ()
    131   "Mark the inside of the current string, not including the quotation marks."
    132   (interactive)
    133   (when (er--point-inside-string-p)
    134     (er--move-point-backward-out-of-string)
    135     (forward-char)
    136     (set-mark (point))
    137     (er--move-point-forward-out-of-string)
    138     (backward-char)
    139     (exchange-point-and-mark)))
    140 
    141 (defun er/mark-outside-quotes ()
    142   "Mark the current string, including the quotation marks."
    143   (interactive)
    144   (if (er--point-inside-string-p)
    145       (er--move-point-backward-out-of-string)
    146     (when (and (not (use-region-p))
    147                (er/looking-back-on-line "\\s\""))
    148       (backward-char)
    149       (er--move-point-backward-out-of-string)))
    150   (when (looking-at "\\s\"")
    151     (set-mark (point))
    152     (forward-char)
    153     (er--move-point-forward-out-of-string)
    154     (exchange-point-and-mark)))
    155 
    156 ;; Pairs - ie [] () {} etc
    157 
    158 (defun er--point-inside-pairs-p ()
    159   "Is point inside any pairs?"
    160   (> (car (syntax-ppss)) 0))
    161 
    162 (defun er/mark-inside-pairs ()
    163   "Mark inside pairs (as defined by the mode), not including the pairs."
    164   (interactive)
    165   (when (er--point-inside-pairs-p)
    166     (goto-char (nth 1 (syntax-ppss)))
    167     (set-mark (save-excursion
    168                 (forward-char 1)
    169                 (skip-chars-forward er--space-str)
    170                 (point)))
    171     (forward-list)
    172     (backward-char)
    173     (skip-chars-backward er--space-str)
    174     (exchange-point-and-mark)))
    175 
    176 (defun er--looking-at-pair ()
    177   "Is point looking at an opening pair char?"
    178   (looking-at "\\s("))
    179 
    180 (defun er--looking-at-marked-pair ()
    181   "Is point looking at a pair that is entirely marked?"
    182   (and (er--looking-at-pair)
    183        (use-region-p)
    184        (>= (mark)
    185            (save-excursion
    186              (forward-list)
    187              (point)))))
    188 
    189 (defun er/mark-outside-pairs ()
    190   "Mark pairs (as defined by the mode), including the pair chars."
    191   (interactive)
    192   (if (and (er/looking-back-on-line "\\s)+\\=")
    193            (not (er--looking-at-pair)))
    194       (ignore-errors (backward-list 1))
    195     (skip-chars-forward er--space-str))
    196   (when (and (er--point-inside-pairs-p)
    197              (or (not (er--looking-at-pair))
    198                  (er--looking-at-marked-pair)))
    199     (goto-char (nth 1 (syntax-ppss))))
    200   (when (er--looking-at-pair)
    201     (set-mark (point))
    202     (forward-list)
    203     (exchange-point-and-mark)))
    204 
    205 (require 'thingatpt)
    206 
    207 (defun er/mark-url ()
    208   (interactive)
    209   (end-of-thing 'url)
    210   (set-mark (point))
    211   (beginning-of-thing 'url))
    212 
    213 (defun er/mark-email ()
    214   (interactive)
    215   (end-of-thing 'email)
    216   (set-mark (point))
    217   (beginning-of-thing 'email))
    218 
    219 (defun er/mark-defun ()
    220   "Mark defun around or in front of point."
    221   (interactive)
    222   (end-of-defun)
    223   (skip-chars-backward er--space-str)
    224   (set-mark (point))
    225   (beginning-of-defun)
    226   (skip-chars-forward er--space-str))
    227 
    228 ;; Methods to try expanding to
    229 (setq er/try-expand-list
    230       (append '(er/mark-word
    231                 er/mark-symbol
    232                 er/mark-symbol-with-prefix
    233                 er/mark-next-accessor
    234                 er/mark-method-call
    235                 er/mark-inside-quotes
    236                 er/mark-outside-quotes
    237                 er/mark-inside-pairs
    238                 er/mark-outside-pairs
    239                 er/mark-comment
    240                 er/mark-url
    241                 er/mark-email
    242                 er/mark-defun)
    243               er/try-expand-list))
    244 
    245 (provide 'er-basic-expansions)
    246 ;;; er-basic-expansions.el ends here