Location: lg@xxxxxxxxxxxxxx http://arch.xwem.org/2005/
Revision: xwem--main--2.1--patch-37
Archive: lg@xxxxxxxxxxxxxx
Creator: Zajcev Evgeny <lg@xxxxxxxx>
Date: Wed Mar 23 01:25:00 MSK 2005
Standard-date: 2005-03-22 22:25:00 GMT
Modified-files: extra/xwem-frametrans.el lisp/xwem-frame.el
lisp/xwem-launcher.el lisp/xwem-selections.el
lisp/xwem-win.el
New-patches: lg@xxxxxxxxxxxxxx/xwem--main--2.1--patch-37
Summary: frametrans fixes, quoted arguments in launcher
Keywords: launcher, xwem-find-file, frametrans
* lisp/xwem-launcher.el (xwem-launcher-split-cmd): [removed]
* lisp/xwem-launcher.el (xwem-launcher-join-cmd): [removed]
* lisp/xwem-launcher.el (xwem-launcher-parse-arguments): [new] Split
command string to arguments list.
* lisp/xwem-launcher.el (xwem-launcher-normalize-cmd): [fix] Use
`xwem-launcher-parse-arguments' now.
* lisp/xwem-launcher.el (xwem-launcher-query): [fix] Use
`xwem-launcher-parse-arguments' now.
* lisp/xwem-launcher.el (xwem-open-file): [fix] Support for spaces in
filenames.
* extra/xwem-frametrans.el: General fixes to make it more useble. To try
out frametrans do:
(require 'xwem-frametrans)
(xwem-frame-set-property nil 'transparency t)
* added files
{arch}/xwem/xwem--main/xwem--main--2.1/lg@xxxxxxxxxxxxxx/patch-log/patch-37
* modified files
--- orig/extra/xwem-frametrans.el
+++ mod/extra/xwem-frametrans.el
@@ -43,6 +43,7 @@
(require 'xwem-load)
(require 'xlib-xshape)
+(require 'xwem-frame)
(defstruct xwem-frame-ft
frame
@@ -73,34 +74,34 @@
(xwem-frame-get-prop frame 'xwem-frame-ft)))
(mask (and xff (xwem-frame-ft-mask xff)))
(xgc (and xff (xwem-frame-ft-gc xff)))
- (xmgc (and xff (xwem-frame-ft-bgc xff)))
- (plist (and xff (xwem-frame-ft-plist xff))))
+ (xmgc (and xff (xwem-frame-ft-bgc xff))))
+; (plist (and xff (xwem-frame-ft-plist xff))))
(when (and (X-Pixmap-p mask)
(X-Gc-p xgc)
(X-Gc-p xmgc))
(XFillRectangle (xwem-dpy) mask xgc 0 0
(xwem-frame-width frame) (xwem-frame-height frame))
- (xwem-win-map (lambda (w)
- (XFillRectangle (xwem-dpy) mask xmgc
- (+ (xwem-win-x w)
- (xwem-win-border-width w))
- (+ (xwem-win-y w)
- (xwem-win-border-width w))
- (- (xwem-win-width w)
- (xwem-win-border-width w)
- (xwem-win-border-width w))
- (- (xwem-win-height w)
- (xwem-win-border-width w)
- (xwem-win-border-width w)))
- (let ((cl (xwem-win-cl w))
- clg)
- (when (and (xwem-cl-p cl) (xwem-cl-active-p cl))
- (setq clg (xwem-cl-xgeom cl))
- (XFillRectangle (xwem-dpy) mask xgc
- (X-Geom-x clg)
- (X-Geom-y clg)
- (X-Geom-width-with-borders clg)
- (X-Geom-height-with-borders clg)))))
+ (xwem-win-map #'(lambda (w)
+ (XFillRectangle (xwem-dpy) mask xmgc
+ (+ (xwem-win-x w)
+ (xwem-win-border-width w))
+ (+ (xwem-win-y w)
+ (xwem-win-border-width w))
+ (- (xwem-win-width w)
+ (xwem-win-border-width w)
+ (xwem-win-border-width w))
+ (- (xwem-win-height w)
+ (xwem-win-border-width w)
+ (xwem-win-border-width w)))
+ (let ((cl (xwem-win-cl w))
+ clg)
+ (when (and (xwem-cl-p cl) (xwem-cl-active-p cl))
+ (setq clg (xwem-cl-xgeom cl))
+ (XFillRectangle (xwem-dpy) mask xgc
+ (X-Geom-x clg)
+ (X-Geom-y clg)
+ (X-Geom-width-with-borders clg)
+ (X-Geom-height-with-borders
clg)))))
(xwem-frame-selwin frame))
(X-XShapeMask (xwem-dpy) (xwem-frame-xwin frame)
X-XShape-Bounding X-XShapeSet 0 0 mask))))
@@ -112,14 +113,6 @@
(xwem-frame-width frame) (xwem-frame-height
frame)))
(gc xwem-misc-mask-fgc)
(bgc xwem-misc-mask-bgc))
-; (gc (XCreateGC (xwem-dpy) xpx
-; (make-X-Gc :dpy (xwem-dpy) :id (X-Dpy-get-id
(xwem-dpy))
-; :foreground 1.0
-; :background 0.0)))
-; (bgc (XCreateGC (xwem-dpy) xpx
-; (make-X-Gc :dpy (xwem-dpy) :id (X-Dpy-get-id
(xwem-dpy))
-; :foreground 0.0
-; :background 1.0))))
(XFillRectangle (xwem-dpy) xpx gc 0 0
(xwem-frame-width frame)
@@ -162,23 +155,38 @@
"Denitialize transparency mask for FRAME."
(let* ((xff (and (xwem-frame-p frame)
(xwem-frame-get-prop frame 'xwem-frame-ft)))
- (xpx (xwem-frame-ft-mask xff))
- (xgc (xwem-frame-ft-gc xff))
- (xmgc (xwem-frame-ft-bgc xff)))
- (XFreeGC (xwem-dpy) xgc)
- (XFreeGC (xwem-dpy) xmgc)
- (XFreePixmap (xwem-dpy) xpx)
-
+ (xpx (xwem-frame-ft-mask xff)))
(xwem-frame-rem-prop frame 'xwem-frame-ft)
-
+ (XFreePixmap (xwem-dpy) xpx)
(X-XShapeMask (xwem-dpy) (xwem-frame-xwin frame)
X-XShape-Bounding X-XShapeSet 0 0 nil)))
+(defun xwem-frame-set-transparency (frame prop val)
+ "Set frame transparency."
+ (xwem-frame-put-prop frame prop val)
+
+ (if val
+ (xwem-ft-mask-init frame)
+ (xwem-ft-mask-deinit frame)))
+
+(defun xwem-frame-get-transparency (frame prop)
+ "Return FRAME's transparency."
+ (xwem-frame-get-prop frame prop))
+
(provide 'xwem-frametrans)
;; On-load actions:
(add-hook 'xwem-frame-resize-hook 'xwem-ft-mask-resize)
-(add-hook 'xwem-frame-redraw-hook 'xwem-ft-fill-mask)
+
+(defadvice xwem-win-redraw-win-1 (after trans-frame activate)
+ "Fill frame transparency mask."
+ (xwem-ft-fill-mask (xwem-win-frame (ad-get-arg 0))))
+
+(define-xwem-frame-property transparency
+ "Make frame to be transparent."
+ :type 'boolean
+ :set 'xwem-frame-set-transparency
+ :get 'xwem-frame-get-transparency)
;;; xwem-frametrans.el ends here
--- orig/lisp/xwem-frame.el
+++ mod/lisp/xwem-frame.el
@@ -434,8 +434,7 @@
(XReparentWindow (xwem-dpy) (xwem-frame-xwin frame) (xwem-rootwin)
(X-Point-x tpnt) (X-Point-y tpnt))
(xwem-frame-set-pos frame (X-Point-x tpnt) (X-Point-y tpnt))
- (xwem-frame-apply-state frame)
- )))
+ (xwem-frame-apply-state frame))))
;;;###xwem-autoload
(defun xwem-select-frame (frame)
--- orig/lisp/xwem-launcher.el
+++ mod/lisp/xwem-launcher.el
@@ -206,32 +206,38 @@
nil 'xwem-launcher-history xwem-launcher-abbrev-table))
(setq read-shell-command-map keymap))))
-(defun xwem-launcher-split-cmd (cmd-with-args)
- "Split string CMD-WITH-ARGS into command and aguments strings.
-Also aplly `executable-find' to find out full path to command.
-Also remove explicit spaces in arguments string."
- (let* ((scmd (remove "" (split-string cmd-with-args " ")))
- (cmd-str (car scmd))
- (arg-str (mapconcat 'identity (cdr scmd) " ")))
- (cons (executable-find cmd-str) arg-str)))
-
-(defun xwem-launcher-join-cmd (cmd-cell)
- "Construct final command from cons cell CMD-CELL.
-`car' of CMD-CELL is cmd and `cdr' is arguments string."
- (when (car cmd-cell)
- (concat (car cmd-cell)
- (if (and (stringp (cdr cmd-cell))
- (> (length (cdr cmd-cell)) 0))
- (concat " " (cdr cmd-cell))
- ""))))
+(defun xwem-launcher-parse-arguments (cmd-str &optional keep-quotes-p)
+ "Parse CMD-STR by spliting it to arguments list.
+If optional KEEP-QUOTES-P is non-nil, quotes in quoted arguments are kept."
+ (let ((scmd (split-string cmd-str " "))
+ qarg args cmd)
+ (while scmd
+ (cond ((stringp qarg)
+ (setq qarg (concat qarg " " (car scmd)))
+ (when (string-match "['\"]$" (car scmd))
+ (setq args (cons (if keep-quotes-p
+ qarg
+ (substring qarg 1 (1- (length qarg))))
+ args)
+ qarg nil)))
+ ((string-match "^['\"]" (car scmd))
+ (setq qarg (car scmd)))
+ (t (setq args (cons (car scmd) args))))
+ (setq scmd (cdr scmd)))
+ ;; Pre-normalise command and its arguments
+ (setq args (remove "" (nreverse args))
+ cmd (executable-find (car args)))
+ (when cmd
+ (cons cmd (cdr args)))))
(defun xwem-launcher-normalize-cmd (cmd)
- "Normalize command CMD.
-Performe `xwem-launcher-split-cmd' and `xwem-launcher-join-cmd'."
- (let ((ncmd (xwem-launcher-split-cmd cmd)))
- (if (null (car ncmd))
- (error 'xwem-error (format "Can't normalize command: %S" cmd))
- (xwem-launcher-join-cmd ncmd))))
+ "Normalize command CMD string.
+Return normalized command string, or signal error if CMD can't be
+normalized."
+ (let ((pargs (xwem-launcher-parse-arguments cmd t)))
+ (unless pargs
+ (error 'xwem-error (format "Can't normalize command: %S" cmd)))
+ (mapconcat #'identity pargs " ")))
;;;###xwem-autoload
(defun xwem-launcher-query (&optional prompt)
@@ -257,8 +263,11 @@
"Execute COMMAND in buffer with BUFFER-NAME.
Unlike `background' do not use shell."
(let* ((cmdargs
- ;; due to split-string args-out-of-range bug
- (condition-case nil (split-string command " ") (t (list command))))
+ ;; Do it under `condition-case', due to split-string
+ ;; args-out-of-range bug.
+ (condition-case nil
+ (xwem-launcher-parse-arguments command)
+ (t (list command))))
(prg (car cmdargs))
(args (cdr cmdargs))
(emacs-env (getenv "EMACS"))
@@ -312,7 +321,7 @@
(when xwem-launcher-beep-done
(xwem-play-sound 'ready))
(xwem-message 'note "Job [%s] %s '%s'" (process-name process)
- msg (mapconcat 'identity
+ msg (mapconcat #'identity
(process-command process) " "))
(if (null (buffer-name (process-buffer process)))
(set-process-buffer process nil) ; WHY? Olin.
@@ -507,7 +516,7 @@
;;;###autoload
(defun xwem-launch-generic-program (cmd sarg)
"Run generic program CMD with arguments SARG."
- (xwem-launch (xwem-launcher-join-cmd (cons cmd sarg))))
+ (xwem-launch (mapconcat #'identity (cons cmd sarg) " ")))
;; Executing xterm
(defun xwem-xterm-construct-cmd (arg)
@@ -865,7 +874,7 @@
(unless command
(setq command (xwem-file-find-command file)))
- (xwem-launch (format "%s %s" command file)))
+ (xwem-launch (format "%s '%s'" command file)))
(provide 'xwem-launcher)
--- orig/lisp/xwem-selections.el
+++ mod/lisp/xwem-selections.el
@@ -189,9 +189,9 @@
(unless (region-active-p)
(error 'xwem-error "No active region"))
- (setq rr (buffer-substring (region-beginning) (region-end)))
- (push rr xwem-selections)
- (xwem-message 'info "Copying: %S" rr))
+ (let ((rr (buffer-substring (region-beginning) (region-end))))
+ (push rr xwem-selections)
+ (xwem-message 'info "Copying: %S" rr)))
(provide 'xwem-selections)
--- orig/lisp/xwem-win.el
+++ mod/lisp/xwem-win.el
@@ -271,7 +271,7 @@
(t (apply 'xwem-win-hacked-or
(mapcar #'(lambda (w)
(xwem-win-find-by-id win-id w))
- (mapcar 'xwem-frame-rootwin
+ (mapcar #'xwem-frame-rootwin
xwem-frames-list))))))
;;;###xwem-autoload
|