| << | < | 2004-05 | > | >> | ||
|---|---|---|---|---|---|---|
| Su | Mo | Tu | We | Th | Fr | Sa |
| 1 | ||||||
| 2 | 3 | 4 | 5 | 6 | 7 | 8 |
| 9 | 10 | 11 | 12 | 13 | 14 | 15 |
| 16 | 17 | 18 | 19 | 20 | 21 | 22 |
| 23 | 24 | 25 | 26 | 27 | 28 | 29 |
| 30 | 31 | |||||
/foo
+svn-mode
|+site-lisp
| +svn
| |-svn.l
| |-svn.lc
| |-readme.txt
+mlx
|+site-lisp
| +mlx
| |-mlx.l
| |-...
| |-...
|
|-packages.l
|-svn-mode.lzh
|-mlx.lzh
|-chocoa-mode.lzh
...
...(provide "myni")
(require "ni/lib")
(require "ni/local")
(require "popwindow") ; 必須じゃない
(defvar *ni-package-file* (merge-pathnames "path/to/packages.l" (si:system-root)))
(defvar *archive-root* (merge-pathnames "path/to/packages" (si:system-root)))
(defvar dlg nil)
(unless dlg
(setq dlg
`(dialog 0 0 268 320
(:caption "Create ni Archive")
(:font 10 "ＭＳ Ｐゴシック")
(:control
; x y x-size y-size
(:static nil "Package Name" #x50000002 10 5 70 10)
(:static nil "Version" #x50000002 10 25 70 10)
(:static nil "Author" #x50000002 10 45 70 10)
(:static nil "Archive Name" #x50000002 10 65 70 10)
(:static nil "Source URL" #x50000002 10 85 70 10)
(:static nil "Description" #x50000002 10 105 70 10)
(:static nil "MD5 sum" #x50000002 10 125 70 10)
(:static nil "Time Stamp" #x50000002 10 145 70 10)
(:static nil "Depends" #x50000002 10 165 70 10)
(:static nil "Category" #x50000002 10 185 70 10)
(:static nil "Changes" #x50000002 10 205 70 10)
(:static nil "Notice" #x50000002 10 245 70 10)
(:static nil "load-after-install" #x50000002 10 285 70 10)
(:static nil "load-before-uninstall" #x50000002 10 305 70 10)
(:edit appname nil #x50810080 82 3 100 11)
(:edit version nil #x50810080 82 23 100 11)
(:edit author nil #x50810080 82 43 100 11)
(:edit archname nil #x50810080 82 63 100 11)
(:edit src nil #x50810080 82 83 180 11)
(:edit description nil #x50810080 82 103 180 11)
(:edit md5 nil #x50800080 82 123 180 11)
(:edit time nil #x50800080 82 143 180 11)
(:edit depends nil #x50810080 82 163 180 11)
(:edit category nil #x50810080 82 183 180 11)
(:edit changes nil #x50b10084 82 203 180 40)
(:edit notice nil #x50b10084 82 243 180 40)
(:edit load-after-install nil #x50810084 82 283 180 11)
(:edit load-before-uninstall nil #x50810084 82 303 180 11)
(:button IDOK "更新(&U)" #x50010001 200 15 50 20)
(:button IDCANCEL "やっぱﾔﾒﾀ(&C)" #x50010000 200 38 50 20)
))))
(defun create-ni-archive (&optional appname)
(interactive)
(let* ((app-name (or appname (read-string "App name: ")))
(path (merge-pathnames app-name *archive-root*))
(curdir (default-directory))
apps dat curapp file files arch-name
)
(when (and (not (string= "" app-name)) (file-directory-p path))
(set-default-directory path)
(setq files (directory path :absolute t :recursive t)) ;archive files
(setq arch-name (merge-pathnames (format nil "~A.lzh" app-name) *archive-root*))
(when (file-exist-p arch-name)
(delete-file arch-name))
(create-archive arch-name files path)
(defun current-app-get (data name)
(find-if #'(lambda (x) (equal (ni::app-name x) name)) data))
(setq file *ni-package-file*)
(setq dat (ni::data-read-from-file file))
(setq apps (ni::site-apps dat))
(setq curapp (current-app-get apps app-name))
(multiple-value-bind (result data)
(dialog-box dlg
(list (cons 'appname (ni::app-name curapp))
(cons 'version (ni::app-version curapp))
(cons 'author (ni::app-author curapp))
(cons 'archname (ni::app-file curapp))
(cons 'src (ni::app-src curapp))
(cons 'md5 (ni::md5sum arch-name))
(cons 'time (format-date-string "%Y/%m/%d %H:%M:%S" (get-universal-time)))
(cons 'description (ni::app-description curapp))
(cons 'depends (format nil "~{~A ~}" (ni::app-depends curapp)))
(cons 'category (format nil "~{~A ~}"(ni::app-category curapp)))
(cons 'changes (substitute-string (ni::app-changes curapp) "\n" "\r\n"))
(cons 'notice (substitute-string (ni::app-notice curapp) "\n" "\r\n"))
(cons 'load-after-install (ni::app-load-after-install curapp))
(cons 'load-before-uninstall (ni::app-load-before-uninstall curapp))
)
'((appname :non-null "hoge " :enable (IDOK)))
)
(when result
(let ((appname (cdr (assoc 'appname data)))
(version (cdr (assoc 'version data)))
(author (cdr (assoc 'author data)))
(archname (cdr (assoc 'archname data)))
(src (cdr (assoc 'src data)))
(description (cdr (assoc 'description data)))
(md5 (cdr (assoc 'md5 data)))
(time (cdr (assoc 'time data)))
(depends (cdr (assoc 'depends data)))
(category (cdr (assoc 'category data)))
(changes (cdr (assoc 'changes data)))
(notice (cdr (assoc 'notice data)))
(load-after-install (cdr (assoc 'load-after-install data)))
(load-before-uninstall (cdr (assoc 'load-before-uninstall data)))
)
(setf (ni::app-name curapp) appname)
(setf (ni::app-version curapp) version)
(setf (ni::app-author curapp) author)
(setf (ni::app-file curapp) archname)
(setf (ni::app-src curapp) src)
(setf (ni::app-description curapp) description)
(setf (ni::app-md5 curapp) md5)
(setf (ni::app-time curapp) time)
(setf (ni::app-depends curapp) (split-string depends #\ nil " "))
(setf (ni::app-category curapp) (split-string category #\ nil " "))
(setf (ni::app-changes curapp) (substitute-string changes "\r\n" "\n"))
(setf (ni::app-notice curapp) (substitute-string notice "\r\n" "\n"))
(setf (ni::app-load-after-install curapp) load-after-install)
(setf (ni::app-load-before-uninstall curapp) load-before-uninstall)
; popwindow パッケージを入れてない場合は、下の1行をコメントアウト
(user::pop-window-pop (format nil "~{~A\n~}" curapp))
(ni::data-write-to-file file dat)
(set-default-directory curdir)
))))))(setq *ni-package-file* "/foo/packages.l")
(setq *archive-root* "/foo")/*
* Edit Control Styles
*/
#define ES_LEFT 0x0000L
#define ES_CENTER 0x0001L
#define ES_RIGHT 0x0002L
#define ES_MULTILINE 0x0004L
#define ES_UPPERCASE 0x0008L
#define ES_LOWERCASE 0x0010L
#define ES_PASSWORD 0x0020L
#define ES_AUTOVSCROLL 0x0040L
#define ES_AUTOHSCROLL 0x0080L
#define ES_NOHIDESEL 0x0100L
#define ES_OEMCONVERT 0x0400L
#define ES_READONLY 0x0800L
#define ES_WANTRETURN 0x1000L
#if(WINVER >= 0x0400)
#define ES_NUMBER 0x2000L
#endif /* WINVER >= 0x0400 */(dialog-box
'(dialog 0 0 200 100
(:caption "test dialog")
(:font 10 "Arial")
(:control
(:button check "checked" #x50009003 5 5 190 75)
(:button IDOK "OK" #x50010001 120 85 35 10)
(:button IDCANCEL "CANCEL" #x50010000 160 85 35 10)
))
(list (cons 'check t))
nil);;; -*- MODE: Lisp; Package: EDITOR; -*-
;;;
;;; quote-menu.l
;;;
;;;
;;; ~/.xyzzy に
;;; (require "quote-menu")
;;;
;;;
;;; code
;;;
(provide "quote-menu")
(in-package "editor")
(defvar *quote-string-list* '(">" "|"))
(defun insert-quote-string-to-selection (&optional (arg 1) (type 1))
(interactive)
(when *prefix-args*
(setq arg *prefix-value*))
(when (pre-selection-p)
(save-excursion
(save-restriction
(narrow-to-region (selection-mark) (selection-point))
(goto-char (point-min))
(loop
(goto-bol)
(insert (nth (1- type) *quote-string-list*) arg)
(when (eql (point-max) (progn (goto-eol) (point)))
(return))
(forward-line 1))))))
(defun delete-quote-string-from-selection (&optional (arg 1) (type 1))
(interactive)
(when *prefix-args*
(setq arg *prefix-value*))
(when (pre-selection-p)
(save-excursion
(save-restriction
(narrow-to-region (selection-mark) (selection-point))
(goto-char (point-min))
(loop
(do ((i 0 (1+ i)))
((= i arg))
(goto-bol)
(when (looking-at (format nil "^~A" (nth (1- type) *quote-string-list*)))
;;; 2004/05/16 修正
; (delete-char 1))
(delete-char (length (nth (1- type) *quote-string-list*))))
)
(when (eql (point-max) (progn (goto-eol) (point)))
(return))
(forward-line 1))))))
(defun add-quote-string-to-clipboard-data (&optional (arg 1) (type 1))
(interactive)
(when *prefix-args*
(setq arg *prefix-value*))
(let ((replace-pattern "\n"))
(insert
(substitute-string
(format nil "~A~A"
(progn
(let ((result nil))
(dolist
(i (make-sequence 'list arg
:initial-element
(nth (1- type) *quote-string-list*)) result)
(setq result (concat result i)))))
(get-clipboard-data))
"\n" (dotimes (tmp arg replace-pattern)
(setq replace-pattern
(format nil "~A~A"
replace-pattern
(nth (1- type) *quote-string-list*))))))))
(defun copy-to-clipboard-with-quote-string (&optional (arg 1) (type 1))
(interactive)
(when *prefix-args*
(setq arg *prefix-value*))
(when (pre-selection-p)
(let ((replace-pattern "\n"))
(copy-to-clipboard
(format nil "~A~A"
(progn
(let ((result nil))
(dolist
(i (make-sequence 'list arg
:initial-element
(nth (1- type) *quote-string-list*)) result)
(setq result (concat result i)))))
(substitute-string
(buffer-substring (selection-mark) (selection-point))
"\n" (dotimes (tmp arg replace-pattern)
(setq replace-pattern
(format nil "~A~A"
replace-pattern
(nth (1- type) *quote-string-list*))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun quote-menu-init ()
(add-popup-menu *app-popup-menu*
(define-popup-menu
(:item 'add-quote "選択範囲の行頭に引用を付加"
'insert-quote-string-to-selection :selection)
(:item nil "選択範囲の行頭にある引用文字の除去"
'delete-quote-string-from-selection :selection)
) "拡張めにう")
(add-menu-separator (get-menu *app-menu* 1 t))
(add-popup-menu (get-menu *app-menu* 1 t)
(define-popup-menu
(:item 'add-quote "選択範囲の行頭に引用を付加"
'insert-quote-string-to-selection :selection)
(:item nil "選択範囲の行頭にある引用文字の除去"
'delete-quote-string-from-selection :selection)
) "拡張めにう")
(unless (get-menu-position (get-menu *app-menu* 1 t) 'ext-copy-1)
(insert-menu-item
(get-menu *app-menu* 1 t) 5 'ext-copy-1
"引用つきコピー" 'copy-to-clipboard-with-quote-string :selection))
(unless (get-menu-position (get-menu *app-menu* 1 t) 'ext-paste-1)
(insert-menu-item
(get-menu *app-menu* 1 t) 8 'ext-paste-1
"引用つき貼り付け" 'add-quote-string-to-clipboard-data :clipboard))
(unless (get-menu-position *app-popup-menu* 'quote-copy)
(insert-menu-item *app-popup-menu* 2 'quote-copy
"引用つきコピー"
'copy-to-clipboard-with-quote-string :selection))
(unless (get-menu-position *app-popup-menu* 'quote-paste)
(insert-menu-item *app-popup-menu* 5 'quote-paste
"引用つき貼り付け"
'add-quote-string-to-clipboard-data :clipboard))
)
(add-hook '*post-startup-hook* 'quote-menu-init)