4
+ − 1 ;;!emacs
+ − 2 ;;
+ − 3 ;; LCD-ENTRY: id-select.el|InfoDock Associates|elisp@infodock.com|Syntactical region selecting|12/02/96|1.4.3|
+ − 4 ;;
+ − 5 ;; FILE: id-select.el
+ − 6 ;; SUMMARY: Select larger and larger syntax-driven regions in a buffer.
+ − 7 ;; USAGE: XEmacs and Emacs Lisp Library
+ − 8 ;; KEYWORDS: matching, mouse
+ − 9 ;;
+ − 10 ;; AUTHOR: Bob Weiner
+ − 11 ;;
+ − 12 ;; ORG: InfoDock Associates. We sell corporate support and development
+ − 13 ;; contracts for InfoDock, Emacs and XEmacs.
+ − 14 ;; E-mail: <info@infodock.com> Web: http://www.infodock.com
+ − 15 ;; Tel: +1 408-243-3300
+ − 16 ;;
+ − 17 ;; ORIG-DATE: 19-Oct-96 at 02:25:27
+ − 18 ;; LAST-MOD: 2-Dec-96 at 19:45:28 by Bob Weiner
+ − 19 ;;
+ − 20 ;; Copyright (C) 1996 InfoDock Associates
+ − 21 ;;
+ − 22 ;; This file is part of InfoDock.
+ − 23 ;; It is available for use and distribution under the terms of the GNU Public
+ − 24 ;; License.
+ − 25 ;;
+ − 26 ;; DESCRIPTION:
+ − 27 ;;
+ − 28 ;; This is a radically cool, drop in mouse and keyboard-based library for
+ − 29 ;; selecting successively bigger syntactical regions within a buffer.
+ − 30 ;; Simply load this library and you are ready to try it out by
+ − 31 ;; double-clicking on various kinds of characters in different buffer major
+ − 32 ;; modes. You'll quickly get the hang of it. (It also provides a command
+ − 33 ;; to jump between beginning and end tags within HTML and SGML buffers.)
+ − 34 ;;
+ − 35 ;; A great deal of smarts are built-in so that it does the right thing
+ − 36 ;; almost all of the time; many other attempts at similar behavior such as
+ − 37 ;; thing.el fail to deal with many file format complexities.
+ − 38 ;;
+ − 39 ;; Double clicks of the Selection Key (left mouse key) at the same point
+ − 40 ;; will select bigger and bigger regions with each successive use. The
+ − 41 ;; first double click selects a region based upon the character at the
+ − 42 ;; point of the click. For example, with the point over an opening or
+ − 43 ;; closing grouping character, such as { or }, the whole grouping is
+ − 44 ;; selected, e.g. a C function. When on an _ or - within a programming
+ − 45 ;; language variable name, the whole name is selected. The type of
+ − 46 ;; selection is displayed in the minibuffer as feedback. When using a
+ − 47 ;; language based mainly on indenting, like Bourne shell, a double click on
+ − 48 ;; the first alpha character of a line, such as an if statement, selects
+ − 49 ;; the whole statement.
+ − 50 ;;
+ − 51 ;; ---------------
+ − 52 ;;
+ − 53 ;; This whole package is driven by a single function, available in mouse
+ − 54 ;; and keyboard forms, that first marks a region based on the syntax
+ − 55 ;; category of the character following point. Successive invocations mark
+ − 56 ;; larger and larger regions until the whole buffer is marked. See the
+ − 57 ;; documentation for the function, id-select-syntactical-region, for the
+ − 58 ;; kinds of syntax categories handled.
+ − 59 ;;
+ − 60 ;; Loading this package automatically installs its functionalty on
+ − 61 ;; double-clicks (or higher) of the left mouse key. (See the documentation
+ − 62 ;; for the variable, mouse-track-click-hook, for how this is done.) A
+ − 63 ;; single click of the left button will remove the region and reset point.
+ − 64 ;;
+ − 65 ;; The function, id-select-thing, may be bound to a key, {C-c s}, seems to
+ − 66 ;; be a reasonable choice, to provide the same syntax-driven region
+ − 67 ;; selection functionality. Use {C-g} to unmark the region when done.
+ − 68 ;; Use, id-select-thing-with-mouse, if you want to bind this to a mouse key
+ − 69 ;; and thereby use single clicks instead of double clicks.
+ − 70 ;;
+ − 71 ;; Three other commands are also provided:
+ − 72 ;; id-select-and-copy-thing - mark and copy the syntactical unit to the
+ − 73 ;; kill ring
+ − 74 ;; id-select-and-kill-thing - kill the syntactical unit at point
+ − 75 ;; id-select-goto-matching-tag - In HTML and SGML modes (actually any
+ − 76 ;; listed in the variable, `id-select-markup-modes'), moves point to the
+ − 77 ;; start of the tag paired with the closest tag that point is within or
+ − 78 ;; which it precedes, so you can quickly jump back and forth between
+ − 79 ;; open and close tags.
+ − 80 ;;
+ − 81 ;; ---------------
+ − 82 ;; SETUP:
+ − 83 ;;
+ − 84 ;; To autoload this package under XEmacs or InfoDock via mouse usage, add
+ − 85 ;; the following line to one of your initialization files. (Don't do this
+ − 86 ;; for GNU Emacs.)
+ − 87 ;;
+ − 88 ;; (add-hook 'mouse-track-click-hook 'id-select-double-click-hook)
+ − 89 ;;
+ − 90 ;; For any version of Emacs you should add the following autoload entries
+ − 91 ;; at your site:
+ − 92 ;;
+ − 93 ;; (autoload 'id-select-and-kill-thing
+ − 94 ;; "id-select" "Kill syntactical region selection" t)
+ − 95 ;; (autoload 'id-select-and-copy-thing
+ − 96 ;; "id-select" "Select and copy syntactical region" t)
+ − 97 ;; (autoload 'id-select-double-click-hook
+ − 98 ;; "id-select" "Double mouse click syntactical region selection" nil)
+ − 99 ;; (autoload 'id-select-thing
+ − 100 ;; "id-select" "Keyboard-driven syntactical region selection" t)
+ − 101 ;; (autoload 'id-select-thing-with-mouse
+ − 102 ;; "id-select" "Single mouse click syntactical region selection" t)
+ − 103 ;;
+ − 104 ;; If you want to be able to select C++ and Java methods and classes by
+ − 105 ;; double-clicking on the first character of a definition or on its opening
+ − 106 ;; or closing brace, you may need the following setting (all
+ − 107 ;; because Sun programmers can't put their opening braces in the first
+ − 108 ;; column):
+ − 109 ;;
+ − 110 ;; (add-hook 'java-mode-hook
+ − 111 ;; (function
+ − 112 ;; (lambda ()
+ − 113 ;; (setq defun-prompt-regexp
+ − 114 ;; "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f]*\\)+\\)?\\s-*"))))
+ − 115 ;;
+ − 116 ;; (add-hook 'c++-mode-hook
+ − 117 ;; (function
+ − 118 ;; (lambda ()
+ − 119 ;; (setq defun-prompt-regexp
+ − 120 ;; "^[ \t]*\\(template[ \t\n\r]*<[^>;.{}]+>[ \t\n\r]*\\)?\\(\\(\\(auto\\|const\\|explicit\\|extern[ \t\n\r]+\"[^\"]+\"\\|extern\\|friend\\|inline\\|mutable\\|overload\\|register\\|static\\|typedef\\|virtual\\)[ \t\n\r]+\\)*\\(\\([[<a-zA-Z][]_a-zA-Z0-9]*\\(::[]_a-zA-Z0-9]+\\)?[ \t\n\r]*<[_<>a-zA-Z0-9 ,]+>[ \t\n\r]*[*&]*\\|[[<a-zA-Z][]_<>a-zA-Z0-9]*\\(::[[<a-zA-Z][]_<>a-zA-Z0-9]+\\)?[ \t\n\r]*[*&]*\\)[*& \t\n\r]+\\)\\)?\\(\\(::\\|[[<a-zA-Z][]_a-zA-Z0-9]*[ \t\n\r]*<[^>;{}]+>[ \t\n\r]*[*&]*::\\|[[<a-zA-Z][]_~<>a-zA-Z0-9]*[ \t\n\r]*[*&]*::\\)[ \t\n\r]*\\)?\\(operator[ \t\n\r]*[^ \t\n\r:;.,?~{}]+\\([ \t\n\r]*\\[\\]\\)?\\|[_~<a-zA-Z][^][ \t:;.,~{}()]*\\|[*&]?\\([_~<a-zA-Z][_a-zA-Z0-9]*[ \t\n\r]*<[^>;{}]+[ \t\n\r>]*>\\|[_~<a-zA-Z][_~<>a-zA-Z0-9]*\\)\\)[ \t\n\r]*\\(([^{;]*)\\(\\([ \t\n\r]+const\\|[ \t\n\r]+mutable\\)?\\([ \t\n\r]*[=:][^;{]+\\)?\\)?\\)\\s-*"))))
+ − 121 ;;
+ − 122 ;; If you want tags, comments, sentences and text blocks to be selectable
+ − 123 ;; in HTML mode, you need to add the following to your personal
+ − 124 ;; initializations (You would do something similar for SGML mode.):
+ − 125 ;;
+ − 126 ;; ;; Make tag begin and end delimiters act like grouping characters,
+ − 127 ;; ;; for easy syntactical selection of tags.
+ − 128 ;; (add-hook 'html-mode-hook
+ − 129 ;; (function
+ − 130 ;; (lambda ()
+ − 131 ;; (modify-syntax-entry ?< "(>" html-mode-syntax-table)
+ − 132 ;; (modify-syntax-entry ?> ")<" html-mode-syntax-table)
+ − 133 ;; (modify-syntax-entry ?\" "\"" html-mode-syntax-table)
+ − 134 ;; (modify-syntax-entry ?= "." html-mode-syntax-table)
+ − 135 ;; (make-local-variable 'comment-start)
+ − 136 ;; (make-local-variable 'comment-end)
+ − 137 ;; (setq comment-start "<!--" comment-end "-->")
+ − 138 ;; (make-local-variable 'sentence-end)
+ − 139 ;; (setq sentence-end "\\([^ \t\n\r>]<\\|>\\(<[^>]*>\\)*\\|[.?!][]\"')}]*\\($\\| $\\|\t\\| \\)\\)[ \t\n]*")
+ − 140 ;;
+ − 141 ;; (define-key html-mode-map "\C-c." 'id-select-goto-matching-tag)
+ − 142 ;; )))
+ − 143 ;;
+ − 144 ;; DESCRIP-END.
+ − 145
+ − 146 ;;; ************************************************************************
+ − 147 ;;; Public variables
+ − 148 ;;; ************************************************************************
+ − 149
+ − 150 (defvar id-select-brace-modes
+ − 151 '(c++-mode c-mode java-mode objc-mode perl-mode tcl-mode)
+ − 152 "*List of language major modes which define things with brace delimiters.")
+ − 153
+ − 154 (defvar id-select-markup-modes
+ − 155 '(html-mode sgml-mode)
+ − 156 "*List of markup language modes that use SGML-style <tag> </tag> pairs.")
+ − 157
+ − 158 (defvar id-select-text-modes
+ − 159 '(fundamental-mode kotl-mode indented-text-mode Info-mode outline-mode text-mode)
+ − 160 "*List of textual modes where paragraphs may be outdented or indented.")
+ − 161
+ − 162 (defvar id-select-indent-modes
+ − 163 (append '(asm-mode csh-mode eiffel-mode ksh-mode python-mode pascal-mode
+ − 164 sather-mode)
+ − 165 id-select-text-modes)
+ − 166 "*List of language major modes which use mostly indentation to define syntactic structure.")
+ − 167
+ − 168 (defvar id-select-indent-non-end-regexp-alist
+ − 169 '((csh-mode "\\(\\|then\\|elsif\\|else\\)[ \t]*$")
+ − 170 (eiffel-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$")
+ − 171 (ksh-mode "\\(\\|then\\|elif\\|else\\)[ \t]*$")
+ − 172 (pascal-mode "\\(\\|then\\|else\\)[ \t]*$")
+ − 173 (python-mode "[ \t]*$")
+ − 174 (sather-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$")
+ − 175 ;;
+ − 176 (fundamental-mode "[^ \t\n]")
+ − 177 (kotl-mode "[^ \t\n]")
+ − 178 (indented-text-mode "[^ \t\n]")
+ − 179 (Info-mode "[^ \t\n]")
+ − 180 (outline-mode "[^\\*]")
+ − 181 (text-mode "[^ \t\n]")
+ − 182 )
+ − 183 "List of (major-mode . non-terminator-line-regexp) elements used to avoid early dropoff when marking indented code.")
+ − 184
+ − 185 (defvar id-select-indent-end-regexp-alist
+ − 186 '((csh-mode "end\\|while")
+ − 187 (eiffel-mode "end")
+ − 188 (ksh-mode "\\(fi\\|esac\\|until\\|done\\)[ \t\n]")
+ − 189 (pascal-mode "end")
+ − 190 (sather-mode "end")
+ − 191 ;;
+ − 192 (fundamental-mode "[ \t]*$")
+ − 193 (indented-text-mode "[ \t]*$")
+ − 194 (Info-mode "[ \t]*$")
+ − 195 (text-mode "[ \t]*$")
+ − 196 )
+ − 197 "List of (major-mode . terminator-line-regexp) elements used to include a final line when marking indented code.")
+ − 198
+ − 199 (defvar id-select-char-p t
+ − 200 "*If t, return single character boundaries when all else fails.")
+ − 201
+ − 202 (defvar id-select-display-type t
+ − 203 "*If t, display the thing selected with each mouse click.")
+ − 204
+ − 205 (defvar id-select-whitespace t
+ − 206 "*If t, groups of whitespace are considered as things.")
+ − 207
+ − 208 (if (string-match "XEmacs" emacs-version)
+ − 209 (add-hook 'mouse-track-click-hook 'id-select-double-click-hook)
+ − 210 (if (string-match "^19\\." emacs-version)
+ − 211 (progn (transient-mark-mode 1)
+ − 212 (global-set-key [mouse-1] 'mouse-set-point)
+ − 213 (global-set-key [double-mouse-1] 'id-select-thing-with-mouse)
+ − 214 (global-set-key [triple-mouse-1] 'id-select-thing-with-mouse))))
+ − 215
+ − 216 ;;; ************************************************************************
+ − 217 ;;; Public functions
+ − 218 ;;; ************************************************************************
+ − 219
+ − 220 ;;
+ − 221 ;; Commands
+ − 222 ;;
+ − 223
+ − 224 ;;;###autoload
+ − 225 (defun id-select-thing ()
+ − 226 "Mark the region selected by the syntax of the thing at point.
+ − 227 If invoked repeatedly, selects bigger and bigger things.
+ − 228 If `id-select-display-type' is non-nil, the type of selection is displayed in
+ − 229 the minibuffer."
+ − 230 (interactive
+ − 231 (cond ((and (fboundp 'region-active-p) (region-active-p))
+ − 232 nil)
+ − 233 ((and (boundp 'transient-mark-mode) transient-mark-mode mark-active)
+ − 234 nil)
+ − 235 (t
+ − 236 ;; Reset selection based on the syntax of character at point.
+ − 237 (id-select-reset)
+ − 238 nil)))
+ − 239 (let ((region (id-select-boundaries (point))))
+ − 240 (if region
+ − 241 (progn (goto-char (car region))
+ − 242 (set-mark (cdr region))
+ − 243 (if (fboundp 'activate-region) (activate-region))
+ − 244 (if (and (boundp 'transient-mark-mode)
+ − 245 transient-mark-mode)
+ − 246 (setq mark-active t))
+ − 247 (and (interactive-p) id-select-display-type
+ − 248 (message "%s" id-select-previous))
+ − 249 (run-hooks 'id-select-thing-hook)
+ − 250 t))))
+ − 251
+ − 252 ;;;###autoload
+ − 253 (defun id-select-thing-with-mouse (event)
+ − 254 "Select a region based on the syntax of the character from a mouse click.
+ − 255 If the click occurs at the same point as the last click, select
+ − 256 the next larger syntactic structure. If `id-select-display-type' is non-nil,
+ − 257 the type of selection is displayed in the minibuffer."
+ − 258 (interactive "@e")
+ − 259 (cond ((and (eq id-select-prior-point (point))
+ − 260 (eq id-select-prior-buffer (current-buffer)))
+ − 261 ;; Prior click was at the same point as before, so enlarge
+ − 262 ;; selection to the next bigger item.
+ − 263 (if (and (id-select-bigger-thing) id-select-display-type)
+ − 264 (progn
+ − 265 ;; Conditionally, save selected region for pasting.
+ − 266 (cond
+ − 267 ;; XEmacs
+ − 268 ((fboundp 'x-store-cutbuffer)
+ − 269 (x-store-cutbuffer (buffer-substring (point) (mark))))
+ − 270 ;; Emacs 19
+ − 271 ((and (boundp 'interprogram-cut-function)
+ − 272 interprogram-cut-function)
+ − 273 (x-set-selection 'PRIMARY (buffer-substring (point) (mark)))))
+ − 274 (message "%s" id-select-previous)))
+ − 275 t)
+ − 276 (t (setq this-command 'mouse-start-selection)
+ − 277 (id-select-reset)
+ − 278 (id-select-thing-with-mouse event))))
+ − 279
+ − 280 ;;;###autoload
+ − 281 (defun id-select-goto-matching-tag ()
+ − 282 "If in a major mode listed in `id-select-markup-modes,' moves point to the start of the tag paired with the closest tag that point is within or precedes.
+ − 283 Returns t if point is moved, else nil.
+ − 284 Signals an error if no tag is found following point or if the closing tag
+ − 285 does not have a `>' terminator character."
+ − 286 (interactive)
+ − 287 (if (not (memq major-mode id-select-markup-modes))
+ − 288 nil
+ − 289 (let ((result)
+ − 290 ;; Assume case of tag names is irrelevant.
+ − 291 (case-fold-search t)
+ − 292 (opoint (point))
+ − 293 (tag)
+ − 294 end-point
+ − 295 start-regexp
+ − 296 end-regexp)
+ − 297
+ − 298 ;; Leave point at the start of the tag that point is within or that
+ − 299 ;; follows point.
+ − 300 (cond
+ − 301 ;; Point is at the start of a tag.
+ − 302 ((looking-at "<[^<> \t\n\r]"))
+ − 303 ;; Point was within a tag.
+ − 304 ((and (re-search-backward "[<>]" nil t)
+ − 305 (looking-at "<[^<> \t\n\r]")))
+ − 306 ;; Move to following tag.
+ − 307 ((and (re-search-forward "<" nil t)
+ − 308 (progn (backward-char 1)
+ − 309 (looking-at "<[^<> \t\n\r]"))))
+ − 310 ;; No tag follows point.
+ − 311 (t (error "(id-select-goto-matching-tag): No tag found after point.")))
+ − 312
+ − 313 (if (catch 'done
+ − 314 (cond
+ − 315 ;; Beginning of a tag pair
+ − 316 ((looking-at "<[^/][^<> \t\n\r]*")
+ − 317 (setq tag (buffer-substring (match-beginning 0) (match-end 0))
+ − 318 start-regexp (regexp-quote tag)
+ − 319 end-regexp (concat "</" (substring start-regexp 1)))
+ − 320 ;; Skip over nested tags.
+ − 321 (let ((count 0)
+ − 322 (regexp (concat start-regexp "\\|" end-regexp))
+ − 323 match-point)
+ − 324 (while (and (>= count 0)
+ − 325 (re-search-forward regexp nil t))
+ − 326 (setq match-point (match-beginning 0))
+ − 327 (if (/= (char-after (1+ (match-beginning 0))) ?/)
+ − 328 ;; Start tag
+ − 329 (setq count (1+ count))
+ − 330 ;; End tag
+ − 331 (setq end-point (point))
+ − 332 (if (or (not (re-search-forward "[<>]" nil t))
+ − 333 (= (preceding-char) ?<))
+ − 334 ;; No terminator character `>' for end tag
+ − 335 (progn (setq result end-point)
+ − 336 (throw 'done nil)))
+ − 337 (setq count (1- count))
+ − 338 (if (= count 0)
+ − 339 (progn
+ − 340 (goto-char match-point)
+ − 341 (setq result t)
+ − 342 (throw 'done result)))))))
+ − 343 ;;
+ − 344 ;; End of a tag pair
+ − 345 ((or (looking-at "</[^> \t\n\r]+")
+ − 346 (and (skip-chars-backward "<")
+ − 347 (looking-at "</[^> \t\n\r]+")))
+ − 348 (goto-char (match-end 0))
+ − 349 (setq tag (buffer-substring (match-beginning 0) (match-end 0))
+ − 350 end-regexp (regexp-quote tag)
+ − 351 start-regexp (concat "<" (substring end-regexp 2)))
+ − 352 (setq end-point (point))
+ − 353 (if (or (not (re-search-forward "[<>]" nil t))
+ − 354 (= (preceding-char) ?<))
+ − 355 ;; No terminator character `>' for end tag
+ − 356 (progn (setq result end-point)
+ − 357 (throw 'done nil)))
+ − 358 ;; Skip over nested tags.
+ − 359 (let ((count 0)
+ − 360 (regexp (concat start-regexp "\\|" end-regexp)))
+ − 361 (while (and (>= count 0)
+ − 362 (re-search-backward regexp nil t))
+ − 363 (if (= (char-after (1+ (point))) ?/)
+ − 364 ;; End tag
+ − 365 (setq count (1+ count))
+ − 366 ;; Start tag
+ − 367 (setq count (1- count))
+ − 368 (if (= count 0)
+ − 369 (progn
+ − 370 (setq result t)
+ − 371 (throw 'done t)))))))))
+ − 372 nil
+ − 373 ;; Didn't find matching tag.
+ − 374 (goto-char opoint))
+ − 375
+ − 376 (cond ((integerp result)
+ − 377 (goto-char result)
+ − 378 (error "(id-select-goto-matching-tag): Add a terminator character for this end <tag>"))
+ − 379 ((null tag)
+ − 380 (error "(id-select-goto-matching-tag): No <tag> following point"))
+ − 381 ((null result)
+ − 382 (if (interactive-p)
+ − 383 (progn
+ − 384 (beep)
+ − 385 (message "(id-select-goto-matching-tag): No matching tag for %s>"
+ − 386 tag)
+ − 387 result)))
+ − 388 (t result)))))
+ − 389
+ − 390 ;;;###autoload
+ − 391 (defun id-select-and-copy-thing ()
+ − 392 "Copy the region surrounding the syntactical unit at point."
+ − 393 (interactive)
+ − 394 (let ((bounds (id-select-boundaries (point))))
+ − 395 (if bounds (copy-region-as-kill (car bounds) (cdr bounds)))))
+ − 396
+ − 397 ;;;###autoload
+ − 398 (defun id-select-and-kill-thing ()
+ − 399 "Kill the region surrounding the syntactical unit at point."
+ − 400 (interactive "*")
+ − 401 (let ((bounds (id-select-boundaries (point))))
+ − 402 (if bounds (kill-region (car bounds) (cdr bounds)))))
+ − 403
+ − 404
+ − 405 ;;
+ − 406 ;; Functions
+ − 407 ;;
+ − 408
+ − 409 (defun id-select-boundaries (pos)
+ − 410 "Return the (start . end) of a syntactically defined region based upon the last region selected or on position POS.
+ − 411 The character at POS is selected if no other thing is matched."
+ − 412 (interactive)
+ − 413 (setq zmacs-region-stays t)
+ − 414 (setcar id-select-old-region (car id-select-region))
+ − 415 (setcdr id-select-old-region (cdr id-select-region))
+ − 416 (let ((prior-type id-select-previous))
+ − 417 (cond
+ − 418 ((eq id-select-previous 'char)
+ − 419 (id-select-syntactical-region pos))
+ − 420 ((and (car id-select-old-region)
+ − 421 (memq id-select-previous
+ − 422 '(sexp sexp-start sexp-end sexp-up))
+ − 423 (id-select-sexp-up pos)
+ − 424 (id-select-region-bigger-p id-select-old-region id-select-region))
+ − 425 id-select-region)
+ − 426 ;;
+ − 427 ;; In the general case, we can't know ahead of time what the next
+ − 428 ;; biggest type of thing to select is, so we test them all and choose
+ − 429 ;; the best fit. This means that dynamically, the order of type
+ − 430 ;; selection will change based on the buffer context.
+ − 431 (t (let ((min-region (1+ (- (point-max) (point-min))))
+ − 432 (result)
+ − 433 region region-size)
+ − 434 (mapcar
+ − 435 (function
+ − 436 (lambda (sym-func)
+ − 437 (setq region
+ − 438 (if (car (cdr sym-func))
+ − 439 (funcall (car (cdr sym-func)) pos)))
+ − 440 (if (and region (car region)
+ − 441 (id-select-region-bigger-p
+ − 442 id-select-old-region region)
+ − 443 (setq region-size
+ − 444 (- (cdr region) (car region)))
+ − 445 (< region-size min-region))
+ − 446 (setq min-region region-size
+ − 447 result
+ − 448 (list;; The actual selection type is
+ − 449 ;; sometimes different than the one we
+ − 450 ;; originally tried, so recompute it here.
+ − 451 (car (assq id-select-previous
+ − 452 id-select-bigger-alist))
+ − 453 (car region) (cdr region))))))
+ − 454 id-select-bigger-alist)
+ − 455 (if result
+ − 456 ;; Returns id-select-region
+ − 457 (progn (setq id-select-previous (car result))
+ − 458 (id-select-set-region (nth 1 result) (nth 2 result)))
+ − 459 ;;
+ − 460 ;; Restore prior selection type since we failed to find a
+ − 461 ;; new one.
+ − 462 (setq id-select-previous prior-type)
+ − 463 (beep)
+ − 464 (message
+ − 465 "(id-select-boundaries): `%s' is the largest selectable region"
+ − 466 id-select-previous)
+ − 467 nil))))))
+ − 468
+ − 469 ;;;###autoload
+ − 470 (defun id-select-double-click-hook (event click-count)
+ − 471 "Select a region based on the syntax of the character wherever the mouse is double-clicked.
+ − 472 If the double-click occurs at the same point as the last double-click, select
+ − 473 the next larger syntactic structure. If `id-select-display-type' is non-nil,
+ − 474 the type of selection is displayed in the minibuffer."
+ − 475 (cond ((/= click-count 2)
+ − 476 ;; Return nil so any other hooks are performed.
+ − 477 nil)
+ − 478 (t (id-select-thing-with-mouse event))))
+ − 479
+ − 480 (defun id-select-syntactical-region (pos)
+ − 481 "Return the (start . end) of a syntactically defined region based upon the buffer position POS.
+ − 482 Uses `id-select-syntax-alist' and the current buffer's syntax table to
+ − 483 determine syntax groups.
+ − 484
+ − 485 Typically:
+ − 486 Open or close grouping character syntax marks an s-expression.
+ − 487 Double quotes mark strings.
+ − 488 The end of a line marks the line, including its trailing newline.
+ − 489 Word syntax marks the current word.
+ − 490 Symbol syntax (such as _) marks a symbol.
+ − 491 Whitespace marks a span of whitespace.
+ − 492 Comment start or end syntax marks the comment.
+ − 493 Punctuation syntax marks the words on both sides of the punctuation.
+ − 494 The fallback default is to mark the character at POS.
+ − 495
+ − 496 If an error occurs during syntax scanning, it returns nil."
+ − 497 (interactive "d")
+ − 498 (setq id-select-previous 'char)
+ − 499 (if (save-excursion (goto-char pos) (eolp))
+ − 500 (id-select-line pos)
+ − 501 (let* ((syntax (char-syntax (if (eobp) (preceding-char) (char-after pos))))
+ − 502 (pair (assq syntax id-select-syntax-alist)))
+ − 503 (cond ((and pair
+ − 504 (or id-select-whitespace
+ − 505 (not (eq (car (cdr pair)) 'thing-whitespace))))
+ − 506 (funcall (car (cdr pair)) pos))
+ − 507 (id-select-char-p
+ − 508 (setq id-select-previous 'char)
+ − 509 (id-select-set-region pos (1+ pos)))
+ − 510 (t
+ − 511 nil)))))
+ − 512
+ − 513 ;;; ************************************************************************
+ − 514 ;;; Private functions
+ − 515 ;;; ************************************************************************
+ − 516
+ − 517 (defun id-select-at-blank-line-or-comment ()
+ − 518 "Return non-nil if on a blank line or a comment start or end line.
+ − 519 Assumes point is befor any non-whitespace character on the line."
+ − 520 (let ((comment-end-p (and (stringp comment-end)
+ − 521 (not (string-equal comment-end "")))))
+ − 522 (if (looking-at
+ − 523 (concat "\\s-*$\\|\\s-*\\(//\\|/\\*\\|.*\\*/"
+ − 524 (if comment-start
+ − 525 (concat
+ − 526 "\\|" (regexp-quote comment-start)))
+ − 527 (if comment-end-p
+ − 528 (concat
+ − 529 "\\|.*" (regexp-quote comment-end)))
+ − 530 "\\)"))
+ − 531 (or (not (and comment-start comment-end-p))
+ − 532 ;; Ignore start and end of comments that
+ − 533 ;; follow non-commented text.
+ − 534 (not (looking-at
+ − 535 (format ".*\\S-.*%s.*%s"
+ − 536 (regexp-quote comment-start)
+ − 537 (regexp-quote comment-end))))))))
+ − 538
+ − 539 (defun id-select-region-bigger-p (old-region new-region)
+ − 540 "Return t if OLD-REGION is smaller than NEW-REGION and NEW-REGION partially overlaps OLD-REGION, or if OLD-REGION is uninitialized."
+ − 541 (if (null (car old-region))
+ − 542 t
+ − 543 (and (> (abs (- (cdr new-region) (car new-region)))
+ − 544 (abs (- (cdr old-region) (car old-region))))
+ − 545 ;; Ensure the two regions intersect.
+ − 546 (or (and (<= (min (cdr new-region) (car new-region))
+ − 547 (min (cdr old-region) (car old-region)))
+ − 548 (> (max (cdr new-region) (car new-region))
+ − 549 (min (cdr old-region) (car old-region))))
+ − 550 (and (> (min (cdr new-region) (car new-region))
+ − 551 (min (cdr old-region) (car old-region)))
+ − 552 (<= (min (cdr new-region) (car new-region))
+ − 553 (max (cdr old-region) (car old-region))))))))
+ − 554
+ − 555 (defun id-select-bigger-thing ()
+ − 556 "Select a bigger object where point is."
+ − 557 (prog1
+ − 558 (id-select-thing)
+ − 559 (setq this-command 'select-thing)))
+ − 560
+ − 561 (defun id-select-reset ()
+ − 562 ;; Reset syntactic selection.
+ − 563 (setq id-select-prior-point (point)
+ − 564 id-select-prior-buffer (current-buffer)
+ − 565 id-select-previous 'char)
+ − 566 (id-select-set-region nil nil))
+ − 567
+ − 568 (defun id-select-set-region (beginning end)
+ − 569 "Set the cons cell held by the variable `id-select-region' to (BEGINNING . END).
+ − 570 Return the updated cons cell."
+ − 571 (setcar id-select-region beginning)
+ − 572 (setcdr id-select-region end)
+ − 573 (if (and (null beginning) (null end))
+ − 574 (progn (setcar id-select-old-region nil)
+ − 575 (setcdr id-select-old-region nil)))
+ − 576 (if (and (not (eq id-select-previous 'buffer))
+ − 577 (integerp beginning) (integerp end)
+ − 578 (= beginning (point-min)) (= end (point-max)))
+ − 579 ;; If we selected the whole buffer, make sure that 'thing' type is 'buffer'.
+ − 580 nil
+ − 581 id-select-region))
+ − 582
+ − 583 (defun id-select-string-p (&optional start-delim end-delim)
+ − 584 "Returns (start . end) of string whose first line point is within or immediately before.
+ − 585 Positions include delimiters. String is delimited by double quotes unless
+ − 586 optional START-DELIM and END-DELIM (strings) are given.
+ − 587 Returns nil if not within a string."
+ − 588 (let ((opoint (point))
+ − 589 (count 0)
+ − 590 bol start delim-regexp start-regexp end-regexp)
+ − 591 (or start-delim (setq start-delim "\""))
+ − 592 (or end-delim (setq end-delim "\""))
+ − 593 ;; Special case for the empty string.
+ − 594 (if (looking-at (concat (regexp-quote start-delim)
+ − 595 (regexp-quote end-delim)))
+ − 596 (id-select-set-region (point) (match-end 0))
+ − 597 (setq start-regexp (concat "\\(^\\|[^\\]\\)\\("
+ − 598 (regexp-quote start-delim) "\\)")
+ − 599 end-regexp (concat "[^\\]\\(" (regexp-quote end-delim) "\\)")
+ − 600 delim-regexp (concat start-regexp "\\|" end-regexp))
+ − 601 (save-excursion
+ − 602 (beginning-of-line)
+ − 603 (setq bol (point))
+ − 604 (while (re-search-forward delim-regexp opoint t)
+ − 605 (setq count (1+ count))
+ − 606 ;; This is so we don't miss the closing delimiter of an empty
+ − 607 ;; string.
+ − 608 (if (and (= (point) (1+ bol))
+ − 609 (looking-at (regexp-quote end-delim)))
+ − 610 (setq count (1+ count))
+ − 611 (if (bobp) nil (backward-char 1))))
+ − 612 (goto-char opoint)
+ − 613 ;; If found an even # of starting and ending delimiters before
+ − 614 ;; opoint, then opoint is at the start of a string, where we want it.
+ − 615 (if (zerop (mod count 2))
+ − 616 (if (bobp) nil (backward-char 1))
+ − 617 (re-search-backward start-regexp nil t))
+ − 618 ;; Point is now before the start of the string.
+ − 619 (if (re-search-forward start-regexp nil t)
+ − 620 (progn
+ − 621 (setq start (match-beginning 2))
+ − 622 (if (re-search-forward end-regexp nil t)
+ − 623 (id-select-set-region start (point)))))))))
+ − 624
+ − 625 ;;;
+ − 626 ;;; Code selections
+ − 627 ;;;
+ − 628
+ − 629 (defun id-select-brace-def-or-declaration (pos)
+ − 630 "If POS is at the first character, opening brace or closing brace of a brace delimited language definition, return (start . end) region, else nil.
+ − 631 The major mode for each supported brace language must be included in the
+ − 632 list, id-select-brace-modes."
+ − 633 (interactive)
+ − 634 (if (not (and (featurep 'cc-mode) (memq major-mode id-select-brace-modes)))
+ − 635 nil
+ − 636 (save-excursion
+ − 637 (goto-char pos)
+ − 638 (let ((at-def-brace
+ − 639 (or (looking-at "^{") (looking-at "^}")
+ − 640 ;; Handle stupid old C-style and new Java
+ − 641 ;; style of putting braces at the end of
+ − 642 ;; lines.
+ − 643 (and (= (following-char) ?{)
+ − 644 (stringp defun-prompt-regexp)
+ − 645 (save-excursion
+ − 646 (beginning-of-line)
+ − 647 (looking-at defun-prompt-regexp)))
+ − 648 (and (= (following-char) ?})
+ − 649 (stringp defun-prompt-regexp)
+ − 650 (condition-case ()
+ − 651 (progn
+ − 652 ;; Leave point at opening brace.
+ − 653 (goto-char
+ − 654 (scan-sexps (1+ (point)) -1))
+ − 655 ;; Test if these are defun braces.
+ − 656 (save-excursion
+ − 657 (beginning-of-line)
+ − 658 (looking-at defun-prompt-regexp)))
+ − 659 (error nil)))))
+ − 660 eod)
+ − 661 (if (or at-def-brace
+ − 662 ;; At the start of a definition:
+ − 663 ;; Must be at the first non-whitespace character in the line.
+ − 664 (and (= (point) (save-excursion (back-to-indentation) (point)))
+ − 665 ;; Must be on an alpha or symbol-constituent character.
+ − 666 ;; Also allow ~ for C++ destructors.
+ − 667 (looking-at "[a-zA-z~]\\|\\s_")
+ − 668 ;; Previous line, if any, must be blank or a comment
+ − 669 ;; start or end or `defun-prompt-regexp' must be defined
+ − 670 ;; for this mode.
+ − 671 (or (stringp defun-prompt-regexp)
+ − 672 (save-excursion
+ − 673 (if (/= (forward-line -1) 0)
+ − 674 t
+ − 675 (id-select-at-blank-line-or-comment))))))
+ − 676 (progn
+ − 677 (setq id-select-previous 'brace-def-or-declaration)
+ − 678 ;; Handle declarations and definitions embedded within classes.
+ − 679 (if (and (= (following-char) ?{)
+ − 680 (/= (point) (save-excursion (back-to-indentation) (point))))
+ − 681 (setq at-def-brace nil))
+ − 682 ;;
+ − 683 (if at-def-brace nil (beginning-of-line))
+ − 684 (if (and (not at-def-brace)
+ − 685 (stringp defun-prompt-regexp)
+ − 686 (looking-at defun-prompt-regexp))
+ − 687 ;; Mark the declaration or definition
+ − 688 (id-select-set-region
+ − 689 (point)
+ − 690 (progn (goto-char (match-end 0))
+ − 691 (if (= (following-char) ?{)
+ − 692 (forward-list 1)
+ − 693 (search-forward ";" nil t))
+ − 694 (skip-chars-forward " \t")
+ − 695 (skip-chars-forward "\n")
+ − 696 (if (looking-at "^\\s-*$")
+ − 697 (forward-line 1))
+ − 698 (point)))
+ − 699 ;; Mark function definitions only
+ − 700 (setq eod (save-excursion
+ − 701 (condition-case ()
+ − 702 (progn
+ − 703 (end-of-defun)
+ − 704 (if (looking-at "^\\s-*$")
+ − 705 (forward-line 1))
+ − 706 (point))
+ − 707 (error (point-max)))))
+ − 708 (if (= (following-char) ?})
+ − 709 ;; Leave point at opening brace.
+ − 710 (goto-char (scan-sexps (1+ (point)) -1)))
+ − 711 (if (= (following-char) ?{)
+ − 712 (progn
+ − 713 (while (and (zerop (forward-line -1))
+ − 714 (not (id-select-at-blank-line-or-comment))))
+ − 715 (if (id-select-at-blank-line-or-comment)
+ − 716 (forward-line 1))))
+ − 717 ;; Mark the whole definition
+ − 718 (setq id-select-previous 'brace-def-or-declaration)
+ − 719 (id-select-set-region (point) eod))))))))
+ − 720
+ − 721 (defun id-select-indent-def (pos)
+ − 722 "If POS is at the first alpha character on a line, return (start . end) region,
+ − 723
+ − 724 The major mode for each supported indented language must be included in the
+ − 725 list, id-select-indent-modes."
+ − 726 (interactive)
+ − 727 (if (not (memq major-mode id-select-indent-modes))
+ − 728 nil
+ − 729 (save-excursion
+ − 730 (goto-char pos)
+ − 731 (if (and
+ − 732 ;; Use this function only if point is on the first non-blank
+ − 733 ;; character of a block, whatever a block is for the current
+ − 734 ;; mode.
+ − 735 (cond ((eq major-mode 'kotl-mode)
+ − 736 (and (looking-at "[1-9*]") (not (kview:valid-position-p))))
+ − 737 ((or (eq major-mode 'outline-mode) selective-display)
+ − 738 (save-excursion (beginning-of-line)
+ − 739 (looking-at outline-regexp)))
+ − 740 ;; After indent in any other mode, must be on an alpha
+ − 741 ;; or symbol-constituent character.
+ − 742 (t (looking-at "[a-zA-z]\\|\\s_")))
+ − 743 ;; Must be at the first non-whitespace character in the line.
+ − 744 (= (point) (save-excursion (back-to-indentation) (point))))
+ − 745 (let* ((start-col (current-column))
+ − 746 (opoint (if (eq major-mode 'kotl-mode)
+ − 747 (progn (kotl-mode:to-valid-position) (point))
+ − 748 (beginning-of-line) (point))))
+ − 749 (while
+ − 750 (and (zerop (forward-line 1))
+ − 751 (bolp)
+ − 752 (or (progn (back-to-indentation)
+ − 753 (> (current-column) start-col))
+ − 754 ;; If in a text mode, allow outdenting, otherwise
+ − 755 ;; only include special lines here indented to the
+ − 756 ;; same point as the original line.
+ − 757 (and (or (memq major-mode id-select-text-modes)
+ − 758 (= (current-column) start-col))
+ − 759 (looking-at
+ − 760 (or (car (cdr
+ − 761 (assq
+ − 762 major-mode
+ − 763 id-select-indent-non-end-regexp-alist)))
+ − 764 "\\'"))))))
+ − 765 (if (and (looking-at
+ − 766 (or (car (cdr (assq major-mode
+ − 767 id-select-indent-end-regexp-alist)))
+ − 768 "\\'"))
+ − 769 (or (memq major-mode id-select-text-modes)
+ − 770 (= (current-column) start-col)))
+ − 771 (forward-line 1))
+ − 772 (beginning-of-line)
+ − 773 ;; Mark the whole definition
+ − 774 (setq id-select-previous 'indent-def)
+ − 775 (id-select-set-region opoint (point)))))))
+ − 776
+ − 777 (defun id-select-symbol (pos)
+ − 778 "Return (start . end) of a symbol at POS."
+ − 779 (or (id-select-markup-pair pos)
+ − 780 ;; Test for indented def here since might be on an '*' representing
+ − 781 ;; an outline entry, in which case we mark entries as indented blocks.
+ − 782 (id-select-indent-def pos)
+ − 783 (save-excursion
+ − 784 (if (memq (char-syntax (if (eobp) (preceding-char) (char-after pos)))
+ − 785 '(?w ?_))
+ − 786 (progn (setq id-select-previous 'symbol)
+ − 787 (condition-case ()
+ − 788 (let ((end (scan-sexps pos 1)))
+ − 789 (id-select-set-region
+ − 790 (min pos (scan-sexps end -1)) end))
+ − 791 (error nil)))))))
+ − 792
+ − 793 (defun id-select-sexp-start (pos)
+ − 794 "Return (start . end) of sexp starting at POS."
+ − 795 (or (id-select-markup-pair pos)
+ − 796 (id-select-brace-def-or-declaration pos)
+ − 797 (save-excursion
+ − 798 (setq id-select-previous 'sexp-start)
+ − 799 (condition-case ()
+ − 800 (id-select-set-region pos (scan-sexps pos 1))
+ − 801 (error nil)))))
+ − 802
+ − 803 (defun id-select-sexp-end (pos)
+ − 804 "Return (start . end) of sexp ending at POS."
+ − 805 (or (id-select-brace-def-or-declaration pos)
+ − 806 (save-excursion
+ − 807 (setq id-select-previous 'sexp-end)
+ − 808 (condition-case ()
+ − 809 (id-select-set-region (scan-sexps (1+ pos) -1) (1+ pos))
+ − 810 (error nil)))))
+ − 811
+ − 812 (defun id-select-sexp (pos)
+ − 813 "Return (start . end) of the sexp that POS is within."
+ − 814 (setq id-select-previous 'sexp)
+ − 815 (save-excursion
+ − 816 (goto-char pos)
+ − 817 (condition-case ()
+ − 818 (id-select-set-region (progn (backward-up-list 1) (point))
+ − 819 (progn (forward-list 1) (point)))
+ − 820 (error nil))))
+ − 821
+ − 822 (defun id-select-sexp-up (pos)
+ − 823 "Return (start . end) of the sexp enclosing the selected area or nil."
+ − 824 (setq id-select-previous 'sexp-up)
+ − 825 ;; Keep going up and backward in sexps. This means that id-select-sexp-up
+ − 826 ;; can only be called after id-select-sexp or after itself.
+ − 827 (setq pos (or (car id-select-region) pos))
+ − 828 (save-excursion
+ − 829 (goto-char pos)
+ − 830 (condition-case ()
+ − 831 (id-select-set-region (progn (backward-up-list 1) (point))
+ − 832 (progn (forward-list 1) (point)))
+ − 833 (error nil))))
+ − 834
+ − 835 (defun id-select-preprocessor-def (pos)
+ − 836 "Return (start . end) of a preprocessor #definition starting at POS, if any.
+ − 837 The major mode for each language that uses # preprocessor notation must be
+ − 838 included in the list, id-select-brace-modes."
+ − 839 ;; Only applies in brace modes (strictly, this should apply in a subset
+ − 840 ;; of brace modes, but doing it this way permits for configurability. In
+ − 841 ;; other modes, one doesn't have to use the function on a # symbol.
+ − 842 (if (not (memq major-mode id-select-brace-modes))
+ − 843 nil
+ − 844 (setq id-select-previous 'preprocessor-def)
+ − 845 (save-excursion
+ − 846 (goto-char pos)
+ − 847 (if (and (= (following-char) ?#)
+ − 848 ;; Must be at the first non-whitespace character in the line.
+ − 849 (= (point) (save-excursion (back-to-indentation) (point))))
+ − 850 (progn
+ − 851 ;; Skip past continuation lines that end with a backslash.
+ − 852 (while (and (looking-at ".*\\\\\\s-*$")
+ − 853 (zerop (forward-line 1))))
+ − 854 (forward-line 1)
+ − 855 ;; Include one trailing blank line, if any.
+ − 856 (if (looking-at "^[ \t\n\r]*$") (forward-line 1))
+ − 857 (id-select-set-region pos (point)))))))
+ − 858
+ − 859 ;; Allow punctuation marks not followed by white-space to include
+ − 860 ;; the previous and subsequent sexpression. Useful in contexts such as
+ − 861 ;; 'foo.bar'.
+ − 862 (defun id-select-punctuation (pos)
+ − 863 "Return (start . end) region including sexpressions before and after POS, when at a punctuation character."
+ − 864 (or (id-select-comment pos)
+ − 865 (id-select-preprocessor-def pos)
+ − 866 (id-select-brace-def-or-declaration pos) ;; Might be on a C++ ;; destructor ~.
+ − 867 (save-excursion
+ − 868 (setq id-select-previous 'punctuation)
+ − 869 (goto-char (min (1+ pos) (point-max)))
+ − 870 (if (= (char-syntax (if (eobp) (preceding-char) (char-after (point))))
+ − 871 ?\ )
+ − 872 (id-select-set-region pos (1+ pos))
+ − 873 (goto-char pos)
+ − 874 (id-select-set-region
+ − 875 (save-excursion (backward-sexp) (point))
+ − 876 (progn (forward-sexp) (point)))))))
+ − 877
+ − 878 (defun id-select-comment (pos)
+ − 879 "Return rest of line from POS to newline."
+ − 880 (setq id-select-previous 'comment)
+ − 881 (save-excursion
+ − 882 (goto-char pos)
+ − 883 (let ((start-regexp (if (stringp comment-start)
+ − 884 (regexp-quote comment-start)))
+ − 885 (end-regexp (if (stringp comment-end)
+ − 886 (regexp-quote comment-end)))
+ − 887 bolp)
+ − 888 (cond
+ − 889 ;; Beginning of a comment
+ − 890 ((and (stringp comment-start)
+ − 891 (or (looking-at start-regexp)
+ − 892 (and (skip-chars-backward comment-start)
+ − 893 (looking-at start-regexp))))
+ − 894 (skip-chars-backward " \t")
+ − 895 (setq bolp (bolp)
+ − 896 pos (point))
+ − 897 (if (equal comment-end "")
+ − 898 (progn (end-of-line)
+ − 899 (id-select-set-region pos (point)))
+ − 900 (if (stringp comment-end)
+ − 901 ;; Skip over nested comments.
+ − 902 (let ((count 0)
+ − 903 (regexp (concat start-regexp "\\|" end-regexp)))
+ − 904 (catch 'done
+ − 905 (while (re-search-forward regexp nil t)
+ − 906 (if (string-equal
+ − 907 (buffer-substring (match-beginning 0) (match-end 0))
+ − 908 comment-start)
+ − 909 (setq count (1+ count))
+ − 910 ;; End comment
+ − 911 (setq count (1- count))
+ − 912 (if (= count 0)
+ − 913 (progn
+ − 914 (if (looking-at "[ \t]*[\n\r]")
+ − 915 ;; Don't include final newline unless the
+ − 916 ;; comment is first thing on its line.
+ − 917 (goto-char (if bolp (match-end 0)
+ − 918 (1- (match-end 0)))))
+ − 919 (throw 'done (id-select-set-region
+ − 920 pos (point))))))))))))
+ − 921 ;; End of a comment
+ − 922 ((and (stringp comment-end)
+ − 923 (not (string-equal comment-end ""))
+ − 924 (or (looking-at end-regexp)
+ − 925 (and (skip-chars-backward comment-end)
+ − 926 (looking-at end-regexp))))
+ − 927 (goto-char (match-end 0))
+ − 928 (if (looking-at "[ \t]*[\n\r]")
+ − 929 (goto-char (match-end 0)))
+ − 930 (setq pos (point))
+ − 931 (skip-chars-forward " \t")
+ − 932 ;; Skip over nested comments.
+ − 933 (let ((count 0)
+ − 934 (regexp (concat start-regexp "\\|" end-regexp)))
+ − 935 (catch 'done
+ − 936 (while (re-search-backward regexp nil t)
+ − 937 (if (string-equal
+ − 938 (buffer-substring (match-beginning 0) (match-end 0))
+ − 939 comment-end)
+ − 940 (setq count (1+ count))
+ − 941 ;; Begin comment
+ − 942 (setq count (1- count))
+ − 943 (if (= count 0)
+ − 944 (progn
+ − 945 (skip-chars-backward " \t")
+ − 946 ;; Don't include final newline unless the comment is
+ − 947 ;; first thing on its line.
+ − 948 (if (bolp) nil (setq pos (1- pos)))
+ − 949 (throw 'done (id-select-set-region
+ − 950 (point) pos)))))))))))))
+ − 951
+ − 952 ;;;
+ − 953 ;;; Textual selections
+ − 954 ;;;
+ − 955
+ − 956 (defun id-select-word (pos)
+ − 957 "Return (start . end) of word at POS."
+ − 958 (or (id-select-brace-def-or-declaration pos)
+ − 959 (id-select-indent-def pos)
+ − 960 (progn (setq id-select-previous 'word)
+ − 961 (save-excursion
+ − 962 (goto-char pos)
+ − 963 (forward-word 1)
+ − 964 (let ((end (point)))
+ − 965 (forward-word -1)
+ − 966 (id-select-set-region (point) end))))))
+ − 967
+ − 968 (defun id-select-string (pos)
+ − 969 "Returns (start . end) of string at POS or nil. Pos include delimiters.
+ − 970 Delimiters may be single, double or open and close quotes."
+ − 971 (setq id-select-previous 'string)
+ − 972 (save-excursion
+ − 973 (goto-char pos)
+ − 974 (if (and (memq major-mode id-select-markup-modes)
+ − 975 (/= (following-char) ?\")
+ − 976 (save-excursion
+ − 977 (and (re-search-backward "[<>]" nil t)
+ − 978 (= (following-char) ?>))))
+ − 979 (progn (setq id-select-previous 'text)
+ − 980 (search-backward ">" nil t)
+ − 981 (id-select-set-region
+ − 982 (1+ (point))
+ − 983 (progn (if (search-forward "<" nil 'end)
+ − 984 (1- (point))
+ − 985 (point)))))
+ − 986 (or (id-select-string-p) (id-select-string-p "'" "'")
+ − 987 (id-select-string-p "`" "'")))))
+ − 988
+ − 989 (defun id-select-sentence (pos)
+ − 990 "Return (start . end) of the sentence at POS."
+ − 991 (setq id-select-previous 'sentence)
+ − 992 (save-excursion
+ − 993 (goto-char pos)
+ − 994 (condition-case ()
+ − 995 (id-select-set-region (progn (backward-sentence) (point))
+ − 996 (progn (forward-sentence) (point)))
+ − 997 (error nil))))
+ − 998
+ − 999 (defun id-select-whitespace (pos)
+ − 1000 "Return (start . end) of all but one char of whitespace POS, unless
+ − 1001 there is only one character of whitespace or this is leading whitespace on
+ − 1002 the line. Then return all of it."
+ − 1003 (setq id-select-previous 'whitespace)
+ − 1004 (save-excursion
+ − 1005 (goto-char pos)
+ − 1006 (if (= (following-char) ?\^L)
+ − 1007 (id-select-page pos)
+ − 1008 (let ((end (progn (skip-chars-forward " \t") (point)))
+ − 1009 (start (progn (skip-chars-backward " \t") (point))))
+ − 1010 (if (looking-at "[ \t]")
+ − 1011 (if (or (bolp) (= (1+ start) end))
+ − 1012 (id-select-set-region start end)
+ − 1013 (id-select-set-region (1+ start) end)))))))
+ − 1014
+ − 1015 (defun id-select-markup-pair (pos)
+ − 1016 "Return (start . end) of region between the opening and closing of an HTML or SGML tag pair, one of which is at POS.
+ − 1017 The major mode for each language that uses such tags must be included in the
+ − 1018 list, id-select-markup-modes."
+ − 1019 (if (not (memq major-mode id-select-markup-modes))
+ − 1020 nil
+ − 1021 (setq id-select-previous 'markup-pair)
+ − 1022 (let ((pos-with-space)
+ − 1023 ;; Assume case of tag names is irrelevant.
+ − 1024 (case-fold-search t)
+ − 1025 (result)
+ − 1026 start-regexp
+ − 1027 end-regexp
+ − 1028 bolp
+ − 1029 opoint)
+ − 1030 (save-excursion
+ − 1031 (catch 'done
+ − 1032 (goto-char pos)
+ − 1033 (cond
+ − 1034 ;; Beginning of a tag pair
+ − 1035 ((looking-at "<[^/][^<> \t\n\r]*")
+ − 1036 (setq start-regexp (regexp-quote (buffer-substring
+ − 1037 (match-beginning 0) (match-end 0)))
+ − 1038 end-regexp (concat "</" (substring start-regexp 1)))
+ − 1039 (setq pos (point))
+ − 1040 (skip-chars-backward " \t")
+ − 1041 (setq bolp (bolp)
+ − 1042 pos-with-space (point))
+ − 1043 ;; Skip over nested tags.
+ − 1044 (let ((count 0)
+ − 1045 (regexp (concat start-regexp "\\|" end-regexp)))
+ − 1046 (while (and (>= count 0)
+ − 1047 (re-search-forward regexp nil t))
+ − 1048 (if (/= (char-after (1+ (match-beginning 0))) ?/)
+ − 1049 ;; Start tag
+ − 1050 (setq count (1+ count))
+ − 1051 ;; Move past end tag terminator
+ − 1052 (setq opoint (point))
+ − 1053 (if (or (not (re-search-forward "[<>]" nil t))
+ − 1054 (= (preceding-char) ?<))
+ − 1055 (progn (setq result opoint)
+ − 1056 (throw 'done nil)))
+ − 1057 (setq count (1- count))
+ − 1058 (if (= count 0)
+ − 1059 (progn
+ − 1060 (if (looking-at "[ \t]*[\n\r]")
+ − 1061 ;; Don't include final newline unless the
+ − 1062 ;; start tag was the first thing on its line.
+ − 1063 (if bolp
+ − 1064 (progn (goto-char (match-end 0))
+ − 1065 ;; Include leading space since the
+ − 1066 ;; start and end tags begin and end
+ − 1067 ;; lines.
+ − 1068 (setq pos pos-with-space))
+ − 1069 (goto-char (1- (match-end 0)))))
+ − 1070 (setq result (id-select-set-region pos (point)))
+ − 1071 (throw 'done nil)))))))
+ − 1072 ;;
+ − 1073 ;; End of a tag pair
+ − 1074 ((or (looking-at "</[^> \t\n\r]+")
+ − 1075 (and (skip-chars-backward "<")
+ − 1076 (looking-at "</[^> \t\n\r]+")))
+ − 1077 (goto-char (match-end 0))
+ − 1078 (setq end-regexp (regexp-quote (buffer-substring
+ − 1079 (match-beginning 0) (match-end 0)))
+ − 1080 start-regexp (concat "<" (substring end-regexp 2)))
+ − 1081 (setq opoint (point))
+ − 1082 (if (or (not (re-search-forward "[<>]" nil t))
+ − 1083 (= (preceding-char) ?<))
+ − 1084 (progn (setq result opoint)
+ − 1085 (throw 'done nil)))
+ − 1086 (setq pos (point))
+ − 1087 (if (looking-at "[ \t]*[\n\r]")
+ − 1088 (setq pos-with-space (match-end 0)))
+ − 1089 ;; Skip over nested tags.
+ − 1090 (let ((count 0)
+ − 1091 (regexp (concat start-regexp "\\|" end-regexp)))
+ − 1092 (while (and (>= count 0)
+ − 1093 (re-search-backward regexp nil t))
+ − 1094 (if (= (char-after (1+ (point))) ?/)
+ − 1095 ;; End tag
+ − 1096 (setq count (1+ count))
+ − 1097 ;; Start tag
+ − 1098 (setq count (1- count))
+ − 1099 (if (= count 0)
+ − 1100 (progn
+ − 1101 (if pos-with-space
+ − 1102 ;; Newline found after original end tag.
+ − 1103 (progn
+ − 1104 (skip-chars-backward " \t")
+ − 1105 (if (bolp)
+ − 1106 ;; Don't include final newline unless the
+ − 1107 ;; start tag is the first thing on its line.
+ − 1108 (setq pos pos-with-space)
+ − 1109 (setq pos (1- pos-with-space))
+ − 1110 ;; Don't include non-leading space.
+ − 1111 (skip-chars-forward " \t"))))
+ − 1112 (setq result (id-select-set-region (point) pos))
+ − 1113 (throw 'done nil))))))))))
+ − 1114 (if (integerp result)
+ − 1115 (progn (goto-char result)
+ − 1116 (error "(id-select-markup-pair): Add a terminator character for this end tag"))
+ − 1117 result))))
+ − 1118
+ − 1119 ;;;
+ − 1120 ;;; Document selections
+ − 1121 ;;;
+ − 1122
+ − 1123 (defun id-select-line (pos)
+ − 1124 "Return (start . end) of the whole line POS is in, with newline unless at end of buffer."
+ − 1125 (setq id-select-previous 'line)
+ − 1126 (save-excursion
+ − 1127 (goto-char pos)
+ − 1128 (let* ((start (progn (beginning-of-line 1) (point)))
+ − 1129 (end (progn (forward-line 1) (point))))
+ − 1130 (id-select-set-region start end))))
+ − 1131
+ − 1132 (defun id-select-paragraph (pos)
+ − 1133 "Return (start . end) of the paragraph at POS."
+ − 1134 (setq id-select-previous 'paragraph)
+ − 1135 (save-excursion
+ − 1136 (goto-char pos)
+ − 1137 (id-select-set-region (progn (backward-paragraph) (point))
+ − 1138 (progn (forward-paragraph) (point)))))
+ − 1139
+ − 1140 (defun id-select-page (pos)
+ − 1141 "Return (start . end) of the page preceding POS."
+ − 1142 (setq id-select-previous 'page)
+ − 1143 (save-excursion
+ − 1144 (goto-char pos)
+ − 1145 (id-select-set-region (progn (backward-page) (point))
+ − 1146 (progn (forward-page) (point)))))
+ − 1147
+ − 1148 (defun id-select-buffer (pos)
+ − 1149 "Return (start . end) of the buffer at POS."
+ − 1150 (setq id-select-previous 'buffer)
+ − 1151 (id-select-set-region (point-min) (point-max)))
+ − 1152
+ − 1153 ;;; ************************************************************************
+ − 1154 ;;; Private variables
+ − 1155 ;;; ************************************************************************
+ − 1156
+ − 1157 (defvar id-select-bigger-alist
+ − 1158 '((char nil)
+ − 1159 (whitespace id-select-whitespace)
+ − 1160 (word id-select-word)
+ − 1161 (symbol id-select-symbol)
+ − 1162 (punctuation nil)
+ − 1163 (string id-select-string)
+ − 1164 (text nil)
+ − 1165 (comment id-select-comment)
+ − 1166 (markup-pair nil)
+ − 1167 (preprocessor-def nil)
+ − 1168 (sexp id-select-sexp)
+ − 1169 (sexp-start nil)
+ − 1170 (sexp-end nil)
+ − 1171 (sexp-up id-select-sexp-up)
+ − 1172 (line id-select-line)
+ − 1173 (sentence id-select-sentence)
+ − 1174 (brace-def-or-declaration id-select-brace-def-or-declaration)
+ − 1175 (indent-def id-select-indent-def)
+ − 1176 (paragraph id-select-paragraph)
+ − 1177 (page id-select-page)
+ − 1178 (buffer id-select-buffer)
+ − 1179 )
+ − 1180 "List of (REGION-TYPE-SYMBOL REGION-SELECTION-FUNCTION) pairs.
+ − 1181 Used to go from one thing to a bigger thing. See id-select-bigger-thing.
+ − 1182 Nil value for REGION-SELECTION-FUNCTION means that region type is skipped
+ − 1183 over when trying to grow the region and is only used when a selection is made
+ − 1184 with point on a character that triggers that type of selection. Ordering of
+ − 1185 entries is largely irrelevant to any code that uses this list.")
+ − 1186
+ − 1187
+ − 1188 (defvar id-select-prior-buffer nil)
+ − 1189 (defvar id-select-prior-point nil)
+ − 1190
+ − 1191 (defvar id-select-previous 'char
+ − 1192 "Most recent type of selection. Must be set by all id-select functions.")
+ − 1193
+ − 1194 (defvar id-select-region (cons 'nil 'nil)
+ − 1195 "Cons cell that contains a region (<beginning> . <end>).
+ − 1196 The function `id-select-set-region' updates and returns it.")
+ − 1197
+ − 1198 (defvar id-select-old-region (cons 'nil 'nil)
+ − 1199 "Cons cell that contains a region (<beginning> . <end>).")
+ − 1200
+ − 1201 (defvar id-select-syntax-alist
+ − 1202 '((?w id-select-word)
+ − 1203 (?_ id-select-symbol)
+ − 1204 (?\" id-select-string)
+ − 1205 (?\( id-select-sexp-start)
+ − 1206 (?\$ id-select-sexp-start)
+ − 1207 (?' id-select-sexp-start)
+ − 1208 (?\) id-select-sexp-end)
+ − 1209 (? id-select-whitespace)
+ − 1210 (?< id-select-comment)
+ − 1211 (?. id-select-punctuation))
+ − 1212 "*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by the function `id-select-syntactical-region'.
+ − 1213 Each FUNCTION takes a single position argument and returns a region
+ − 1214 (start . end) delineating the boundaries of the thing at that position.
+ − 1215 Ordering of entries is largely irrelevant to any code that uses this list.")
+ − 1216
+ − 1217
+ − 1218 (provide 'id-select)
