Annotation of /skeleton-edit/init.lAnnotation of /skeleton-edit/init.l
Parent Directory
| 
Revision Log
Revision: 1.1 - (view) (download)
| 1 : | ktanaka | 1.1 | ;; |
| 2 : | ;; init.l | ||
| 3 : | ;; $Revision: 1.1 $ | ||
| 4 : | ;; | ||
| 5 : | |||
| 6 : | ;; ------------------------- ;; | ||
| 7 : | ;; make display, screen, ... ;; | ||
| 8 : | ;; ------------------------- ;; | ||
| 9 : | (defun setup-display () | ||
| 10 : | (if (and (boundp 'display) (display-p display)) | ||
| 11 : | (cleanup-display)) | ||
| 12 : | |||
| 13 : | ; tanaka | ||
| 14 : | (setq grid nil) | ||
| 15 : | (setq display-host (get-display-host)) | ||
| 16 : | (or display-host (progn (format "Display unknown/n") | ||
| 17 : | (funcall (function err:argument-type)))) | ||
| 18 : | |||
| 19 : | (setq display (open-display display-host)) | ||
| 20 : | (setq screen (first (display-roots display))) | ||
| 21 : | (setq root (screen-root screen)) | ||
| 22 : | |||
| 23 : | (setq black (screen-black-pixel screen) | ||
| 24 : | white (screen-white-pixel screen)) | ||
| 25 : | |||
| 26 : | (setq kanji-font (open-font display "k14") | ||
| 27 : | ascii-font (open-font display "a14")) | ||
| 28 : | |||
| 29 : | (setq colmap (screen-default-colormap screen)) | ||
| 30 : | (setq color-map-black (first (lookup-color colmap "black"))) | ||
| 31 : | (setq color-map-white (first (lookup-color colmap "white"))) | ||
| 32 : | (setq cursor-font (open-font display "cursor")) | ||
| 33 : | |||
| 34 : | (setq roupe-cursor (create-glyph-cursor | ||
| 35 : | :source-font cursor-font | ||
| 36 : | :source-char 24 | ||
| 37 : | :mask-font cursor-font | ||
| 38 : | :mask-char 25 | ||
| 39 : | :foreground color-map-black | ||
| 40 : | :background color-map-white) | ||
| 41 : | please-wait-cursor (create-glyph-cursor | ||
| 42 : | :source-font cursor-font | ||
| 43 : | :source-char 150 | ||
| 44 : | :mask-font cursor-font | ||
| 45 : | :mask-char 151 | ||
| 46 : | :foreground color-map-black | ||
| 47 : | :background color-map-white) | ||
| 48 : | hair-cross-cursor (create-glyph-cursor | ||
| 49 : | :source-font cursor-font | ||
| 50 : | :source-char 34 | ||
| 51 : | :mask-font cursor-font | ||
| 52 : | :mask-char 35 | ||
| 53 : | :foreground color-map-black | ||
| 54 : | :background color-map-white)) | ||
| 55 : | |||
| 56 : | (setq root-blackgc (create-gcontext :drawable root | ||
| 57 : | :fill-rule ':winding | ||
| 58 : | :foreground black :background white | ||
| 59 : | :font kanji-font)) | ||
| 60 : | |||
| 61 : | (setq root-whitegc (create-gcontext :drawable root | ||
| 62 : | :foreground white :background black | ||
| 63 : | :font kanji-font)) | ||
| 64 : | |||
| 65 : | (setq root-reversegc (create-gcontext :drawable root | ||
| 66 : | :foreground black :background white | ||
| 67 : | :font kanji-font | ||
| 68 : | :function boole-c1)) | ||
| 69 : | |||
| 70 : | (setq root-xorgc (create-gcontext :drawable root | ||
| 71 : | :function boole-eqv)) | ||
| 72 : | |||
| 73 : | (setq root-dashlinegc (create-gcontext :drawable root | ||
| 74 : | :line-style ':double-dash | ||
| 75 : | :function boole-c1)) | ||
| 76 : | |||
| 77 : | (setq root-saveblackgc (create-gcontext :drawable root | ||
| 78 : | :foreground black | ||
| 79 : | :background white | ||
| 80 : | :font kanji-font)) | ||
| 81 : | |||
| 82 : | (setq root-savewhitegc (create-gcontext :drawable root | ||
| 83 : | :foreground white | ||
| 84 : | :background black | ||
| 85 : | :font kanji-font)) | ||
| 86 : | |||
| 87 : | (setq default-depth (screen-depth screen)) | ||
| 88 : | ) | ||
| 89 : | |||
| 90 : | (defun screen-depth (scr) | ||
| 91 : | (let ((alist (screen-depths scr))) | ||
| 92 : | (do ((p alist (cdr p))) | ||
| 93 : | ((or (null p) | ||
| 94 : | (not (null (cdar p)))) | ||
| 95 : | (if (null p) nil (caar p))) | ||
| 96 : | (comment print p)))) | ||
| 97 : | |||
| 98 : | (defun cleanup-display () | ||
| 99 : | (close-display display)) | ||
| 100 : |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |