home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
m
/
me_cd25.zip
/
MUTT2.ZIP
/
REGISTER.MUT
< prev
next >
Wrap
Lisp/Scheme
|
1992-11-09
|
3KB
|
91 lines
;; register.mut
;; Implements a subset of GNU Emacs's register commands.
;; Diffs:
;; In insert register, I use the opposite behavior for dot and mark (of
;; GNU) to be consistant with yank. See comments in insert-register if
;; you want to change it back.
;; Not implemented:
;; Saving positions in registers.
;; C Durland 8/92 Public Domain
(include me2.h)
(array small-int registers 36)
(defun
get-register-num (string prompt) HIDDEN
{
(int n)
(n { (msg prompt " (0-9, a-z): ")(get-key) })
(if (== n 0x147) (abort)) ;; ^G
(if (not (or ;; !((0 <= x <= 9) || (a <= x <= z))
(and (<= 0x30 n) (<= n 0x39)) ;; 0-9
(and (<= 0x61 n) (<= n 0x7A)))) ;; a-z
{ (msg "Out of bounds (0-9, a-z)!")(halt) })
;; convert key to 0 - 35
;; '0' - '9' => 0-9, 'a'-'z' => 10-35
(if (<= n 0x39) (- n 0x30) (- n 0x57))
}
;; Insert the contents of a register at the dot.
;; Normally, the dot is left before the register text, the mark after
;; (oppsite of yank). With arg, behaves like yank.
;; Uggg. I can't stand it - for consistancy, I going with the way
;; yank works. You can change it back by easily (uncomment some
;; lines and comment one).
insert-register
{
; (byte type)(small-int width height)(int size) ;; struct BagInfo
(int n)
(n (get-register-num "Insert register"))
(if (== 0 (n (registers n))) { (msg "Nothing in register!")(done) })
(set-mark THE-MARK)
(insert-bag n)
; (bag-stats n (loc type))
;; GNU Emacs like behaivor:
;; if rectangle: need-to-swap-marks == arg-flag
;; if !rectangle: need-to-swap-marks == !arg-flag
; (if (if (== type BAG-IS-RECTANGLE) (arg-flag) (not (arg-flag)))
; (swap-marks THE-DOT THE-MARK))
;; yank like:
(if (arg-flag) (swap-marks THE-DOT THE-MARK))
}
copy-to-register
{
(int n bag)
(n (get-register-num "Copy to register"))
(if (== 0 (registers n)) (registers n (create-bag TRUE)) )
(bag (registers n))
(clear-bag bag)(append-to-bag bag APPEND-REGION)
(if (arg-flag) (delete-region))
}
copy-region-to-rectangle
{
(int n bag)
(n (get-register-num "Copy rectangle to register"))
(if (== 0 (registers n)) (registers n (create-bag TRUE)) )
(bag (registers n))
(clear-bag bag)(append-to-bag bag APPEND-RECTANGLE)
(if (arg-flag) (erase-rectangle TRUE))
}
)
(defun MAIN
{
(bind-to-key "copy-to-register" "C-xx")
(bind-to-key "copy-region-to-rectangle" "C-xr")
(bind-to-key "insert-register" "C-xg")
})