PageRenderTime 56ms CodeModel.GetById 26ms RepoModel.GetById 0ms app.codeStats 0ms

/incoming/X-0.3a/xhello.el

https://github.com/emacsmirror/ohio-archive
Emacs Lisp | 122 lines | 72 code | 10 blank | 40 comment | 0 complexity | c76be99f2f48d2bf8b8e857374c90f2f MD5 | raw file
  1. ;;; hello --- hello world X demo/testbed
  2. ;; Copyright (C) 1996, 1997, 1998 Eric M. Ludlam
  3. ;;
  4. ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
  5. ;; Version: 0.1
  6. ;; Keywords: X
  7. ;; X-RCS: $Id: xhello.el,v 1.4 1998/03/10 23:38:59 zappo Exp $
  8. ;;
  9. ;; This program is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13. ;;
  14. ;; This program is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;;
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this program; if not, you can either send email to this
  21. ;; program's author (see below) or write to:
  22. ;;
  23. ;; The Free Software Foundation, Inc.
  24. ;; 675 Mass Ave.
  25. ;; Cambridge, MA 02139, USA.
  26. ;;
  27. ;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
  28. ;;
  29. ;;; Commentary:
  30. ;;
  31. ;; Example HELLO WORLD Emacs X program
  32. (require 'xlib)
  33. ;;; Code:
  34. (defvar Xhello-gc-1 nil)
  35. (defvar Xhello-gc-2 nil)
  36. (defun XX (host)
  37. "Do as much as I know so far. Connect to HOST."
  38. (interactive "sHost: ")
  39. (let* ((dpy (XOpenDisplay host))
  40. (w (if (aref dpy 0)
  41. (XCreateWindow dpy nil 20 20 100 100 20 nil nil nil
  42. (X-attribute
  43. nil ;new one
  44. 'X-attr-background-pixel (XWhitePixel dpy)
  45. 'X-attr-border-pixel (XBlackPixel dpy)
  46. 'X-attr-event-mask
  47. (Xmask-or XM-Exposure
  48. XM-StructureNotify
  49. )))
  50. nil))
  51. (cmap (XDefaultColormap dpy)) ;(XCreateColormap dpy w))
  52. (co (X-Color dpy nil)))
  53. (if w
  54. (progn
  55. ;; Set the WM protocols so that if we are killed, the X connection
  56. ;; is not lost.
  57. (let ((wmdw (XInternAtom dpy "WM_DELETE_WINDOW" nil)))
  58. (if (not wmdw) (error "Failed to allocate atoms!"))
  59. (XSetWMProtocols dpy w (list wmdw))
  60. (X-add-event-handler w 33 'Xhello-close-window))
  61. ;; Lets set up some colors and GCs for drawing.
  62. (XAllocNamedColor dpy cmap "Red" co)
  63. (setq Xhello-gc-1
  64. (XCreateGC dpy w
  65. (X-GC dpy nil
  66. 'X-GC-foreground (X-get-id co)
  67. 'X-GC-background (XWhitePixel dpy 0)
  68. 'X-GC-line-style X-LineSolid
  69. 'X-GC-line-width 1)))
  70. (XAllocNamedColor dpy cmap "Green" co)
  71. (setq Xhello-gc-2
  72. (XCreateGC dpy w
  73. (X-GC dpy nil
  74. 'X-GC-foreground (X-get-id co)
  75. 'X-GC-background (XWhitePixel dpy 0)
  76. 'X-GC-line-style X-LineDoubleDash
  77. 'X-GC-line-width 2)))
  78. ;(X-set-window-close w 'Xhello-close-window)
  79. (X-set-window-expose w 'Xhello-expose)
  80. (X-set-window-reconfigure w 'Xhello-reconfigure)
  81. (XMapWindow dpy w)))
  82. (XBell dpy 100)
  83. ))
  84. (defun Xhello-expose (win params)
  85. ;; checkdoc-params: (params)
  86. "Expose the hello window WIN."
  87. (let ((dpy (X-window-get-display win)))
  88. (XDrawLine dpy win Xhello-gc-2 5 5 100 50)
  89. (XDrawPoint dpy win Xhello-gc-1 20 5)
  90. (XFillRectangle dpy win Xhello-gc-2 2 38 38 15)
  91. (XDrawRectangle dpy win Xhello-gc-1 2 38 38 15)
  92. (XDrawString dpy win Xhello-gc-1 5 50 "HELLO!")
  93. (XDrawSegments dpy win Xhello-gc-2 '(100 0 50 10 100 100 50 90))
  94. (XDrawArc dpy win Xhello-gc-1 50 50 20 20 0 (* 360 64))
  95. (XFillArc dpy win Xhello-gc-2 55 55 10 10 0 (* 360 64))
  96. ))
  97. (defun Xhello-reconfigure (win event params)
  98. "Reconfigure the HELLO window WIN.
  99. For this pass, mearly print out EVENT and PARAMS."
  100. (message "Event %d: %S" event params))
  101. (defun Xhello-close-window (win params)
  102. "Called when WIN is closed. Called with PARAMS."
  103. ;; This is a client message
  104. (let* ((dpy (X-window-get-display win))
  105. (data (nth 3 params))
  106. (a2 (XInternAtom dpy "WM_DELETE_WINDOW" nil))
  107. )
  108. ;(message "Expect: %f Msg: %f" (X-get-id a2) (car (car data)))
  109. (if (= (X-get-id a2) (car (car data)))
  110. (XDestroyWindow dpy win))))
  111. (provide 'xhello)
  112. ;;; xhello.el ends here