home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
me34exe.zip
/
mutt
/
package
/
dabbrev.mut
< prev
next >
Wrap
Text File
|
1995-01-14
|
8KB
|
229 lines
;; dynamic abbreviation for me
;; Patrick TJ McPhee 4 and 11 July, 1993
;;
;; this is meant to work like the dabbrev command in GNU emacs, to the
;; extent that I know how dabbrev works there. Here's the documentation:
;;
;; Dynamic abbreviation allows word replacement without maintaining a
;; file of abbreviations and replacements. It's a standard part of GNU
;; emacs, and I find it useful in most of the circumstances where one
;; would use an abbrev mode (documents), and also in places where an
;; abbrev mode is less convenient (programs). Here's how it works:
;; Type the beginning of a word and press (by default) M-/. If there
;; is another word in the current buffer which starts the same way, the
;; partial word will be replaced by that other word. Press M-/ again,
;; and another will be used, and so-on until all eligible words in the
;; current buffer are used. At that point, the original fragment is
;; put back in place, and the message `Can't satisfy you.' is displayed
;; in the minibuffer. You can start again at this point.
;;
;; Advantages of this approach over standard abbreviation: you don't need
;; to define any abbreviations; it's less disconcerting, since you always
;; ask for the abbreviation explicitly; and it's easy to undo.
;; Advantages of standard abbreviation over this approach: you have to
;; explicitly ask for each abbreviation; standard abbrev is faster, and you
;; can't abbreviate phrases.
;;
;; This is version 1.0. It seems to work, but I don't know what I'm doing,
;; and I've only spent about half a day getting it going, so I'm sure there
;; are improvements waiting to be made.
;; Massive hacks 7/93 C Durland
(include me.mh)
(bool dabbrev-search-reverse)
(const CMD-NO-FLAG 99)
(int dabbrev-cmd-flag)
(list dabbrev-rejects)
(string dabbrev-search-string)
(defun
MAIN
{
(dabbrev-cmd-flag (command-flag CMDFLG-GEN-FLAG 0))
}
;; to initialise, make some buffer vars. This is for marks - since they
;; are buffer specific, don't want to have to search out their buffer to
;; free them.
dabbrev-allocations HIDDEN {
(create-buffer-var NUMBER "dabbrev-search-location")
;; take advantage of fact that NUMBERs are initialised to 0 and
;; mark 0 is always taken by the dot
;; If I knew how to tell that a buffer-var already exists, I'd do this
;; differently
(if (== 0 (buffer-var "dabbrev-search-location")) {
(buffer-var "dabbrev-search-location" (create-mark TRUE))
})
}
dabbrev-expand {
(int start end search-loc)
(bool found-it repeating)
(string replace-text)
;; This does nothing if previously defined.
;; If I knew how to test for previous allocation, I would.
(dabbrev-allocations)
(search-loc (buffer-var "dabbrev-search-location"))
(repeating (command-flag CMDFLG-TEST dabbrev-cmd-flag))
(command-flag CMDFLG-SET dabbrev-cmd-flag)
(arg-flag FALSE 1) ;; reset arg count
(start (create-mark))
(end (create-mark))
;; if we're sitting on the end mark, we're repeating. Otherwise we
;; need to do some initialisation.
(if repeating {
;; I'm already at the end of the word
(set-mark end)
;; and can easily find the beginning
(forward-word -1)(set-mark start)
}{ ;; else not repeating
(set-mark end) ;; might not be end of word, same as GNU
;; find the beginning of a word
(forward-word -1) (set-mark start)
;; which is more-or-less where we'll start searching
; (forward-char -1)
(set-mark search-loc)
(dabbrev-search-reverse TRUE)
;; now clear out the reject list
(remove-elements dabbrev-rejects 0 (length-of dabbrev-rejects))
;; now, is this a word, or is there more than one word put the
;; region delimited by start and end into a bag, convert it to a
;; string, and check it out.
(dabbrev-search-string (region-to-string start end))
;; get out if there isn't a word in the region
(if (not (re-string '\w+$' dabbrev-search-string)) {
(msg "No abbreviations here")
(goto-mark end)
(command-flag CMDFLG-SET CMD-NO-FLAG) ;; Start over next time
(done)
})
;; otherwise save the search string and add it to the list of
;; rejected values
(insert-object dabbrev-rejects 0 dabbrev-search-string)
})
;; the rest is the same regardless of which time we're doing this.
;; search for dabbrev-search-string until you find it at the start
;; of a word, and it's not in the list. Finally add it and replace
;; the start/end region with the new text
(goto-mark search-loc)
(found-it FALSE)
(if dabbrev-search-reverse
(while (and
(found-it (search-reverse dabbrev-search-string))
(rejected-p dabbrev-search-string))
()))
;; search forward if we didn't find it
(if (not found-it) {
;; if were searching backwards and haven't found it, switch directions
(if dabbrev-search-reverse {
(dabbrev-search-reverse FALSE)
(goto-mark end)
(set-mark search-loc)
})
(while (and
(found-it (search-forward dabbrev-search-string))
(rejected-p dabbrev-search-string))
())
})
;; now, we've found it, and we haven't rejected it yet
(if (found-it) {
;; big assumption about the last call to looking-at
(replace-text (get-matched "&"))
(replace-region (replace-text) start end)
(insert-object dabbrev-rejects -1 replace-text)
} {
;; otherwise we do the same thing, but put the search text back in
;; place. Also, make sure we don't repeat next time.
(replace-region dabbrev-search-string start end)
(command-flag CMDFLG-SET CMD-NO-FLAG)
(msg "Can't satisfy you.")
})
}
;;;;;;;;;;
;; returns TRUE if current search text is in the list of previous
;; replacements
rejected-p (string s-t) HIDDEN {
(bool good-word)
(string replace-text)
(int rep-list-length n)
;; we'll do next search from here regardless
(set-mark (buffer-var "dabbrev-search-location"))
;; but we want to do replacement from start of the current word
(forward-char 1) (forward-word -1)
(good-word (and (looking-at (s-t))(looking-at '\w\w*')))
(goto-mark (buffer-var "dabbrev-search-location"))
(if (not good-word) { TRUE (done) })
;; set replace-text to the current word
(replace-text (get-matched "&"))
;; and see if it's in the replacement list
(rep-list-length (length-of dabbrev-rejects))
(for (n 0) (< n rep-list-length) (+= n 1)
(if (== replace-text (extract-element dabbrev-rejects n)) {
TRUE
(done)
}))
FALSE ;; its a new word
}
;;;;;;;;;;;
;; put r-text in place of the region delimited by s-mark and e-mark
;; and leave the dot at the end of the inserted text
replace-region (string r-text) (int s-mark e-mark) HIDDEN {
(goto-mark s-mark)
(delete-region s-mark e-mark)
(insert-text r-text)
}
;;;;;;;;;;
;; return TRUE if marks are at the same place, FALSE otherwise
;; this is in my wish-list for built-in functions
; match-marks-p (int one-mark another-mark) HIDDEN {
; (byte type)(small-int left-edge width height)(int size) ;; RegionInfo
;
; (if (and (mark-valid one-mark)(mark-valid another-mark))
; {
; (region-stats (loc type) one-mark another-mark)
; (and (== 0 width)(== 1 height))
; }
; FALSE)
; }
)
;; Notes:
;; Don't free the bag so that it will stick around until garbage
;; collection. This way the string won't be collected before we
;; use it.
(defun
region-to-string (int start end)
{
(int bag)
(bag (create-bag))
(append-to-bag bag APPEND-REGION start end)
(bag-to-string bag)
}
)