;;; ctwm-fns.el --- functions for interaction with ctwm window manager ;; Author: Noah Friedman ;; Created: 2015-02-01 ;; Public domain. ;; $Id: ctwm-fns.el,v 1.8 2020/04/17 22:07:18 friedman Exp $ ;;; Commentary: ;;; Code: (require 'frame-fns) (require 'cl-lib) (defvar ctwm-workspace-frames-alist nil "*Alist of frames to create using `make-ctwm-workspace-frames'. Each member of the list is a key or list of keys, followed by a set of frames to create. The keys are usually a hostname or list of hostnames. The corresponding value is a list of lists of parameters which are given to `make-frame-on-ctwm-workspace' (which see). Some examples: \(setq ctwm-workspace-frames-alist '(((\"host1.fqdn.com\" \"host2\" \"host3\") (0 \"80x24+0-0\") (1 \"239x85+0+0\" nil t)) (\"my-multi-screened-host\" ([0 -1] \"80x66-0-0\" ((font . \"terminus6x12u\"))) ([0 0] \"80x24+0-0\") ([1 -1] \"80x66-0-0\") ([1 0] \"254x79+0+0\" nil t))))") (defvar iconify-new-ctwm-workspace-frames nil "*When non-nil, `make-frame-on-ctwm-workspace' will leave newly-created frames iconified. Otherwise, they are made visible after placing them on the correct workspace.") (defun ctwm-workspace-count (&optional display) "Return the total number of ctwm workspaces on DISPLAY. DISPLAY can be am X display string, a frame, or nil meaning the display of the specified or selected frame." (with-selected-display display (or (frame-xprop 0 "_NET_NUMBER_OF_DESKTOPS") ;; 4.0 and above (frame-xprop 0 "_WIN_WORKSPACE_COUNT")))) (defun ctwm-workspace-names (&optional display) "Return a list of all named ctwm workspaces on DISPLAY. DISPLAY can be am X display string, a frame, or nil meaning the display of the specified or selected frame." (with-selected-display display (or (frame-xprop 0 "WM_WORKSPACESLIST") ;; 4.0 and above (frame-xprop 0 "_WIN_WORKSPACE_NAMES")))) (defun ctwm-lookup-workspace (display ws) "Validate workspace name or value WS and return normalized value, or nil. DISPLAY can be am X display string, a frame, or nil meaning the display of the specified or selected frame. WORKSPACE can be the name of a ctwm workspace, a zero-origin index number into the workspace list, or one of the symbols `next' or `prev'. Nonexistent workspace names are ignored. Workspace numbers larger or smaller than the total number of available workspaces will wrap around to the modulus of the number of workspaces. Thus, the first workspace is 0 and the last workspace can be referenced with -1. The symbols `next' and `prev' wrap around to the first or last workspace, respectively, if they overflow." (cond ((stringp ws) (let ((names (ctwm-workspace-names display))) (car (member ws names)))) ((numberp ws) (let ((count (ctwm-workspace-count display))) (mod ws count))) ((memq ws '(next prev)) (let* ((count (ctwm-workspace-count display)) (cur (frame-ctwm-workspace-number display)) (new (if (eq ws 'next) (1+ cur) (1- cur)))) (mod new count))))) (defun frame-ctwm-workspace-number (&optional frame) "Return the ctwm workspace number, as an integer, for frame FRAME. This appears to return only one value even if the frame occupies multiple workspaces, and the number it returns may not even be for the current workspace. Better to use `frame-ctwm-workspace-name' instead." (or (frame-xprop frame "_NET_WM_DESKTOP") ;; 4.0 and above (frame-xprop frame "_WIN_WORKSPACE"))) (defun frame-ctwm-workspace-name (&optional frame) "Return the name(s) of current ctwm workspace for frame FRAME as a list. The frame may occupy more than workspace." (frame-xprop frame "WM_OCCUPATION")) ;; n.b. Emacs 19 frame parameters return top/left shifted by -1. ;; Emacs 21 returns top/left shifted by +1 ;; All others, including v20 (as of v25) are correct ;; The buggy two are too old to bother compensating for. (defun ctwm-remap-frame (&optional frame) "Unmap and re-map FRAME so that new window manager hints will take effect. FRAME defaults to the selected frame if nil." (unless frame (setq frame (selected-frame))) (let* ((wm-state (frame-xprop frame "WM_STATE")) (parm (mapcar (lambda (p) (cons p (frame-parameter frame p))) '(visibility left top))) (vis (cdar parm)) (x (cdr (nth 1 parm))) (y (cdr (nth 2 parm)))) ;; Tell window manager hints where mapping is preferred. Emacs just ;; uses XMoveWindow, but doesn't set hints and the window manager may ;; ignore the window location when it gets a map notification otherwise. ;; We need to do this before unmapping the frame. (set-frame-wm-normal-hint frame 'user-location x y) ;;(x-synchronize t frame) (make-frame-invisible frame) (setcdr (assq 'visibility parm) 'icon) (modify-frame-parameters frame parm) ;; remaps frame iconified ;; Restore ctwm's idea of the frame's mapping state. ;; If it was iconified before, it will remain iconified. ;; If it was deiconified in principle but iconified while not visible ;; current workspace, It will either remain in that state or (if window ;; is now on current workspace) ctwm will deiconify it. (set-frame-xprop frame "WM_STATE" wm-state "WM_STATE") ;;(x-synchronize nil frame) frame)) (defun set-frame-ctwm-workspace (frame workspace) "Move FRAME to ctwm workspace WORKSPACE. WORKSPACE can be any value recognized by `ctwm-lookup-workspace'. Returns the frame object which was affected." (let ((new (ctwm-lookup-workspace frame workspace))) (cond ((stringp new) (set-frame-xprop frame "WM_OCCUPATION" new)) ((numberp new) (let* ((names (ctwm-workspace-names)) (ws (nth (mod new (length names)) names))) (set-frame-xprop frame "WM_OCCUPATION" ws))) (t (signal 'domain-error (list "Invalid workspace specification" frame workspace))))) (ctwm-remap-frame frame)) (defun make-frame-on-ctwm-workspace (workspace geomstr &optional params no-wm-decorations) "Create frame on ctwm WORKSPACE with X geometry GEOMSTR. WORKSPACE may be an integer workspace number, a string representing the name of a workspace, or it may be a vector composed of the X screen number and the workspace name or number on that screen. This last option is supported because, while one could just specify the X display in the PARAMS argument, this permits specifying the screen without having to know the X server major device number ahead of time (e.g. are you on :0 or :20 ?). GEOMSTR is a string in the form of a Xt geometry specification, e.g. \"80x24+0+0\". Optional arg PARAMS are a further set of Emacs frame parameters to use in the creation of the frame. Optional arg NO-WM-DECORATIONS means try to create a frame with no borders or titles. This may not have any effect unless you configure ctwm not to decorate windows whose title is \"notitle\" when they are first mapped. \(The name is changed afterward, but ctwm does not redecorate them.) Returns the frame object created." (let* ((screen (if (vectorp workspace) (prog1 (aref workspace 0) (setq workspace (aref workspace 1))))) (display (if screen (list (cons 'display (ffx-screen-display-name screen (cdr (assq 'display params))))))) (titles (if no-wm-decorations '((name . "notitle") (icon-name . "notitle") (title . "notitle")))) (frame (make-frame-with-geometry geomstr (append '((visibility . icon)) display titles params)))) (set-frame-ctwm-workspace frame workspace) (when no-wm-decorations (large-simple-frame-setup frame)) (unless iconify-new-ctwm-workspace-frames (set-frame-parameter frame 'visible t)) frame)) ;;;###autoload (defun make-ctwm-workspace-frames (&optional host) "Select the list of frames specified for the current host from \ `ctwm-workspace-frames-alist' and create them on their designated \ screens/workspaces. The search is done first on the fully-qualified name returned by `system-name', and secondarily on that name sans any domain component. Finally, if no host match is found, look for a geometry string of the form \"WIDTHxHEIGHT\" matching the dimensions of the selected frame's display. Optional argument HOST means look for the entries for that host instead of the current host. In that case, the name must match one of the keys exactly. If called from lisp, the return value is a list of the newly created frames, or nil if no keys matched." (interactive) (let* ((sn (system-name)) (shost (save-match-data (substring sn (string-match "^[^.]+" sn) (match-end 0)))) (geom (format "%sx%s" (display-pixel-width) (display-pixel-height))) (tbl ctwm-workspace-frames-alist) (pred (lambda (key elt) (if (stringp elt) (string= key elt) (member key elt))))) (mapcar (lambda (elt) (apply 'make-frame-on-ctwm-workspace elt)) (cdr (if host (cl-assoc host tbl :test pred) (or (cl-assoc sn tbl :test pred) (cl-assoc shost tbl :test pred) (cl-assoc geom tbl :test pred))))))) (provide 'ctwm-fns) ;;; ctwm-fns.el ends here.