home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / xmr / dm-xmr.el next >
Encoding:
Text File  |  1992-03-29  |  5.7 KB  |  242 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;
  3. ;;; File:     dm-xmr.el
  4. ;;; Author:   Ik Su Yoo <ik@ctt.bellcore.com>
  5. ;;; Date:     03/17/92
  6. ;;; Contents: Dynamic Macros for XMR mode.
  7. ;;;
  8. ;;; Copyright (c) 1992 Ik Su Yoo.
  9. ;;;
  10. ;;; May be redistributed only under the terms of the GNU Emacs General
  11. ;;; Public License.
  12. ;;;
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14.  
  15. (require 'dmacro)
  16.  
  17. ;;;
  18. ;;; Helping functions.
  19. ;;;
  20.  
  21. (defvar dmacro-last-input nil)
  22.  
  23. (defun right-trim (string charbag)
  24.   (let ((endp (length string)))
  25.     (while (and (> endp 0) (memq (elt string (- endp 1)) charbag))
  26.       (setq endp (- endp 1)))
  27.     (if (zerop endp)
  28.     ""
  29.       (substring string 0 endp))))
  30.  
  31. (defun read-string-and-save (prompt-string)
  32.   (setq dmacro-last-input (read-string prompt-string)))
  33.  
  34. (defun insert-pushbuttons (prompt-string)
  35.   (insert-homogeneous-children "XmPushButton"))
  36.  
  37. (defun insert-togglebuttons (prompt-string)
  38.   (insert-homogeneous-children "XmToggleButton"))
  39.  
  40. (defun insert-cascadebuttons (prompt-string)
  41.   (insert-homogeneous-children "XmCascadeButton"))
  42.  
  43. (defun insert-homogeneous-children (class-name)
  44.   (if (null dmacro-last-input)
  45.       ""
  46.     (apply 'concat
  47.        (mapcar '(lambda (name)
  48.               (format "*%s.wcClassName:\t%s\n\n"
  49.                   (right-trim (symbol-name name) '(?,))
  50.                   class-name))
  51.            (car (read-from-string (format "(%s)" dmacro-last-input)))))
  52.     ))
  53.  
  54. ;;;
  55. ;;; XMR mode dmacros.
  56. ;;;
  57.  
  58. (add-dmacros 'xmr-mode-abbrev-table
  59.   (append
  60.    (mapcar '(lambda (class-name)
  61.           (list
  62.            ;;
  63.            ;; Dmacro doesn't like upper case letters in the macro name.
  64.            ;;
  65.            (substring (downcase class-name) 2)
  66.            (format "~(mark)*~(prompt name).wcClassName:%s~@\n"
  67.                class-name)
  68.            nil
  69.            nil))
  70.        '(
  71.          "XmArrowButton"
  72.          "XmCascadeButton"
  73.          "XmDrawnButton"
  74.          "XmLabel"
  75.          "XmList"
  76.          "XmPushButton"
  77.          "XmScale"
  78.          "XmScrollBar"
  79.          "XmSelectionBox"
  80.          "XmSeparator"
  81.          "XmText"
  82.          "XmTextField"
  83.          "XmToggleButton"
  84.          ))
  85.    (mapcar '(lambda (class-name)
  86.           (list
  87.            ;;
  88.            ;; Dmacro doesn't like upper case letters in the macro name.
  89.            ;;
  90.            (substring (downcase class-name) 2)
  91.            (format "~(mark)*~(prompt name).wcClassName:%s\n*~(prompt name).wcChildren:~@\n"
  92.                class-name)
  93.            nil
  94.            nil))
  95.        '(
  96.          "XmBulletinBoard"
  97.          "XmCommand"
  98.          "XmDrawingArea"
  99.          "XmFileSelectionBox"
  100.          "XmForm"
  101.          "XmFrame"
  102.          "XmMainWindow"
  103.          "XmManager"
  104.          "XmMessageBox"
  105.          "XmPanedWindow"
  106.          "XmRowColumn"
  107.          "XmScrolledWindow"
  108.          ))
  109.    '(
  110.      ("menubar"
  111.       "~(mark)\
  112. *~(prompt name).wcConstructor:    XmCreateMenuBar
  113. *~(prompt name).wcChildren:    ~(prompt children)
  114. ~@"
  115.       nil
  116.       nil)
  117.  
  118.      ("pulldownmenu"
  119.       "~(mark)\
  120. *~(prompt name).wcConstructor:    XmCreatePulldownMenu
  121. *~(prompt name).wcChildren:    ~(prompt children nil read-string-and-save)
  122. *~(prompt name).wcManaged:    false
  123.  
  124. ~(prompt children-spec nil insert-pushbuttons)~@"
  125.       nil
  126.       nil)
  127.  
  128.      ("optionmenu"
  129.       "~(mark)\
  130. *~(prompt name)Menu.wcConstructor:    XmCreatePullDownMenu
  131. *~(prompt name)Menu.wcChildren:        ~(prompt children nil read-string-and-save)
  132. *~(prompt name)Menu.wcManaged:        false
  133.  
  134. *~(prompt name).wcClassName:        XmRowColumn
  135. *~(prompt name).rowColumnType:        MENU_OPTION
  136. *~(prompt name).subMenuId:        *~(prompt name)Menu
  137.  
  138. ~(prompt children-spec nil insert-pushbuttons)~@"
  139.       nil
  140.       nil)
  141.  
  142.      ("radiobox"
  143.       "~(mark)\
  144. *~(prompt name).wcClassName:    XmRowColumn
  145. *~(prompt name).wcChildren:    ~(prompt children nil read-string-and-save)
  146. *~(prompt name).radioBehavior:    true
  147.  
  148. ~(prompt children-spec nil insert-togglebuttons)~@"
  149.       nil
  150.       nil)
  151.  
  152.      ("genericdialog"
  153.       "~(mark)\
  154. *~(prompt name).wcConstructor: XmCreatePromptDialog
  155. *~(prompt name).wcCallback: \\
  156.     WcUnmanageCB(*~(prompt name)*Selection, \\
  157.          *~(prompt name)*sb_text, \\
  158.          *~(prompt name)*Help)
  159. *~(prompt name).wcChildren:~@"
  160.       nil
  161.       nil)
  162.  
  163.      ("filemenu"
  164.       "~(mark)\
  165. *fileMenu.wcConstructor:        XmCreatePulldownMenu
  166. *fileMenu.wcChildren:            new open save saveAs menuSep quit
  167. *fileMenu.wcManaged:            false
  168.  
  169. *new.wcClassName:            XmPushButton
  170. *new.accelerator:            Ctrl <Key> N
  171. *new.acceleratorText:            Ctrl-N
  172. *new.labelString:            New
  173. *new.mnemonic:                N
  174.  
  175. *open.wcClassName:            XmPushButton
  176. *open.accelerator:            Ctrl <Key> O
  177. *open.acceleratorText:            Ctrl-O
  178. *open.labelString:            Open
  179. *open.mnemonic:                O
  180.  
  181. *save.wcClassName:            XmPushButton
  182. *save.accelerator:            Ctrl <Key> S
  183. *save.acceleratorText:            Ctrl-S
  184. *save.labelString:            Save
  185. *save.mnemonic:                S
  186.  
  187. *saveAs.wcClassName:            XmPushButton
  188. *saveAs.labelString:            Save as...
  189. *saveAs.mnemonic:            a
  190.  
  191. *quit.wcClassName:            XmPushButton
  192. *quit.accelerator:            Ctrl <Key> Q
  193. *quit.acceleratorText:            Ctrl-Q
  194. *quit.labelString:            Quit
  195. *quit.mnemonic:                Q
  196.  
  197. *file.wcClassName:            XmCascadeButtonGadget
  198. *file.labelString:            File
  199. *file.mnemonic:                F
  200. *file.subMenuId:            *fileMenu
  201. ~@
  202. "
  203.       nil
  204.       nil)
  205.  
  206.      ("editmenu"
  207.       "~(mark)\
  208. *editMenu.wcConstructor:        XmCreatePulldownMenu
  209. *editMenu.wcChildren:            cut copy paste menuSep undo
  210. *editMenu.wcManaged:            false
  211.  
  212. *cut.wcClassName:            XmPushButton
  213. *cut.accelerator:            <Key> Delete
  214. *cut.acceleratorText:            Delete
  215. *cut.labelString:            Cut
  216. *cut.mnemonic:                C
  217.  
  218. *copy.wcClassName:            XmPushButton
  219. *copy.accelerator:            Ctrl <Key> Delete
  220. *copy.acceleratorText:            Ctrl-Delete
  221. *copy.labelString:            Copy
  222. *copy.mnemonic:                O
  223.  
  224. *paste.wcClassName:            XmPushButton
  225. *paste.accelerator:            <Key> Insert
  226. *paste.acceleratorText:            Insert
  227. *paste.labelString:            Paste
  228. *paste.mnemonic:            P
  229.  
  230. *edit.wcClassName:            XmCascadeButtonGadget
  231. *edit.labelString:            Edit
  232. *edit.mnemonic:                E
  233. *edit.subMenuId:            *editMenu
  234. ~@"
  235.       nil
  236.       nil))
  237.    ))
  238.  
  239. (define-key xmr-mode-map "\C-cd" 'insert-dmacro)
  240.  
  241. (provide 'xmr-dmacro)
  242.