Ignore:
Timestamp:
Mar 24, 2009, 4:17:08 PM (10 years ago)
Author:
gz
Message:

Fix for #389 - if there is a selection, m-u/m-l/m-c operate on the selection.

Add a Capitalize Region command, but remove the default key bindings for all of Lowercase/Uppercase/Capitalize? Region commands, since they're now largely redundant with m-u/m-l/m-c.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/morecoms.lisp

    r8428 r11838  
    5454   With prefix argument uppercase that many words."
    5555  "Uppercase p words at the point."
    56   (filter-words p (current-point) #'string-upcase))
     56  (if (region-active-p)
     57    (hemlock::uppercase-region-command p)
     58    (filter-words p (current-point) #'string-upcase)))
    5759
    5860(defcommand "Lowercase Word" (p)
     
    6062   With prefix argument uppercase that many words."
    6163  "Uppercase p words at the point."
    62   (filter-words p (current-point) #'string-downcase))
     64  (if (region-active-p)
     65    (hemlock::lowercase-region-command p)
     66    (filter-words p (current-point) #'string-downcase)))
    6367
    6468;;; FILTER-WORDS implements "Uppercase Word" and "Lowercase Word".
     
    8084  words before the point, but leaves the point where it was."
    8185  "Capitalize p words at the point."
    82   (let ((point (current-point))
    83         (arg (or p 1)))
    84     (with-mark ((start point :left-inserting)
    85                 (end point))
    86       (when (minusp arg)
    87         (unless (word-offset start arg) (editor-error "No previous word.")))
    88       (do ((region (region start end))
    89            (cnt (abs arg) (1- cnt)))
    90           ((zerop cnt) (move-mark point end))
    91         (unless (find-attribute start :word-delimiter #'zerop)
    92           (editor-error "No next word."))
    93         (move-mark end start)
    94         (find-attribute end :word-delimiter)
    95         (loop
    96           (when (mark= start end)
    97             (move-mark point end)
    98             (editor-error "No alphabetic characters in word."))
    99           (when (alpha-char-p (next-character start)) (return))
    100           (character-offset start 1))
    101         (setf (next-character start) (char-upcase (next-character start)))
    102         (hi::buffer-note-modification (current-buffer) start 1)
    103         (mark-after start)
    104         (filter-region #'string-downcase region)))))
     86  (if (region-active-p)
     87    (hemlock::capitalize-region-command p)
     88    (let ((point (current-point))
     89          (arg (or p 1)))
     90      (with-mark ((start point)
     91                  (end point))
     92        (when (minusp arg)
     93          (unless (word-offset start arg) (editor-error "No previous word.")))
     94        (do ((region (region start end))
     95             (cnt (abs arg) (1- cnt)))
     96            ((zerop cnt) (move-mark point end))
     97          (unless (find-not-attribute start :word-delimiter)
     98            (editor-error "No next word."))
     99          (move-mark end start)
     100          (unless (find-attribute end :word-delimiter)
     101            (buffer-end end))
     102          (capitalize-one-word region))))))
     103
     104(defun capitalize-one-word (region)
     105  "Capitalize first word in region, moving region-start to region-end"
     106  (let* ((start (region-start region))
     107         (end (region-end region)))
     108    ;; (assert (mark<= start end))
     109    (loop
     110      (when (mark= start end)
     111        (return nil))
     112      (let ((ch (next-character start)))
     113        (when (alpha-char-p ch)
     114          (setf (next-character start) (char-upcase ch))
     115          (hi::buffer-note-modification (current-buffer) start 1)
     116          (mark-after start)
     117          (filter-region #'string-downcase region)
     118          (move-mark start end)
     119          (return t)))
     120      (mark-after start))))
    105121
    106122(defcommand "Uppercase Region" (p)
     
    125141           (undo-region (copy-region region)))
    126142      (filter-region function region)
     143      (move-mark (current-point) end)
    127144      (make-region-undo :twiddle name region undo-region))))
    128145
    129 
     146(defcommand "Capitalize Region" (p)
     147  "Capitalize words from point to mark."
     148  (declare (ignore p))
     149  (let* ((current-region (current-region))
     150         (start (copy-mark (region-start current-region) :left-inserting))
     151         (end (copy-mark (region-end current-region) :left-inserting))
     152         (region (region start end))
     153         (undo-region (copy-region region)))
     154    (capitalize-words-in-region region)
     155    (move-mark (current-point) end)
     156    (make-region-undo :twiddle "Capitalize Region" region undo-region)))
     157
     158(defun capitalize-words-in-region (region)
     159  (let ((limit (region-end region)))
     160    (with-mark ((start (region-start region)))
     161      (with-mark ((end start))
     162        (let ((region (region start end)))
     163          (loop
     164            (unless (and (find-not-attribute start :word-delimiter)
     165                         (mark< start limit))
     166              (return))
     167            ;; start is at a word constituent, there is at least one start <  limit
     168            (move-mark end start)
     169            (unless (find-attribute end :word-delimiter)
     170              (buffer-end end))
     171            (when (mark< limit end)
     172              (move-mark end limit))
     173            (capitalize-one-word region)
     174            (move-mark start end)))))))
    130175
    131176
Note: See TracChangeset for help on using the changeset viewer.