diff options
Diffstat (limited to 'lisp/term/haiku-win.el')
| -rw-r--r-- | lisp/term/haiku-win.el | 153 |
1 files changed, 153 insertions, 0 deletions
diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el new file mode 100644 index 00000000000..c4810f116d2 --- /dev/null +++ b/lisp/term/haiku-win.el @@ -0,0 +1,153 @@ +;;; haiku-win.el --- set up windowing on Haiku -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Support for using Haiku's BeOS derived windowing system. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(unless (featurep 'haiku) + (error "%s: Loading haiku-win without having Haiku" + invocation-name)) + +;; Documentation-purposes only: actually loaded in loadup.el. +(require 'frame) +(require 'mouse) +(require 'scroll-bar) +(require 'menu-bar) +(require 'fontset) +(require 'dnd) + +(add-to-list 'display-format-alist '(".*" . haiku)) + +;;;; Command line argument handling. + +(defvar x-invocation-args) +(defvar x-command-line-resources) + +(defvar haiku-initialized) + +(declare-function x-open-connection "haikufns.c") +(declare-function x-handle-args "common-win") +(declare-function haiku-selection-data "haikuselect.c") +(declare-function haiku-selection-put "haikuselect.c") +(declare-function haiku-selection-targets "haikuselect.c") +(declare-function haiku-selection-owner-p "haikuselect.c") +(declare-function haiku-put-resource "haikufns.c") + +(defun haiku--handle-x-command-line-resources (command-line-resources) + "Handle command line X resources specified with the option `-xrm'. +The resources should be a list of strings in COMMAND-LINE-RESOURCES." + (dolist (s command-line-resources) + (let ((components (split-string s ":"))) + (when (car components) + (haiku-put-resource (car components) + (string-trim-left + (mapconcat #'identity (cdr components) ":"))))))) + +(cl-defmethod window-system-initialization (&context (window-system haiku) + &optional display) + "Set up the window system. WINDOW-SYSTEM must be HAIKU. +DISPLAY may be set to the name of a display that will be initialized." + (cl-assert (not haiku-initialized)) + + (create-default-fontset) + (when x-command-line-resources + (haiku--handle-x-command-line-resources + (split-string x-command-line-resources "\n"))) + (x-open-connection (or display "be") x-command-line-resources t) + (setq haiku-initialized t)) + +(cl-defmethod frame-creation-function (params &context (window-system haiku)) + (x-create-frame-with-faces params)) + +(cl-defmethod handle-args-function (args &context (window-system haiku)) + (x-handle-args args)) + +(defun haiku--selection-type-to-mime (type) + "Convert symbolic selection type TYPE to its MIME equivalent. +If TYPE is nil, return \"text/plain\"." + (cond + ((eq type 'STRING) "text/plain;charset=iso-8859-1") + ((eq type 'UTF8_STRING) "text/plain") + ((stringp type) type) + ((symbolp type) (symbol-name type)) + (t "text/plain"))) + +(cl-defmethod gui-backend-get-selection (type data-type + &context (window-system haiku)) + (if (eq data-type 'TARGETS) + (apply #'vector (mapcar #'intern + (haiku-selection-targets type))) + (haiku-selection-data type (haiku--selection-type-to-mime data-type)))) + +(cl-defmethod gui-backend-set-selection (type value + &context (window-system haiku)) + (haiku-selection-put type "text/plain" value t)) + +(cl-defmethod gui-backend-selection-exists-p (selection + &context (window-system haiku)) + (haiku-selection-data selection "text/plain")) + +(cl-defmethod gui-backend-selection-owner-p (selection &context (window-system haiku)) + (haiku-selection-owner-p selection)) + +(declare-function haiku-read-file-name "haikufns.c") + +(defun x-file-dialog (prompt dir &optional default-filename mustmatch only-dir-p) + "SKIP: real doc in xfns.c." + (if (eq (framep-on-display (selected-frame)) 'haiku) + (haiku-read-file-name (if (not (string-suffix-p ": " prompt)) + prompt + (substring prompt 0 (- (length prompt) 2))) + (selected-frame) + (or dir (and default-filename + (file-name-directory default-filename))) + mustmatch only-dir-p + (file-name-nondirectory default-filename)) + (error "x-file-dialog on a tty frame"))) + +(defun haiku-dnd-handle-drag-n-drop-event (event) + "Handle specified drag-n-drop EVENT." + (interactive "e") + (let* ((string (caddr event)) + (window (posn-window (event-start event)))) + (with-selected-window window + (raise-frame) + (dnd-handle-one-url window 'private (concat "file:" string))))) + +(define-key special-event-map [drag-n-drop] + 'haiku-dnd-handle-drag-n-drop-event) + +(defvaralias 'haiku-use-system-tooltips 'use-system-tooltips) + +(defun haiku-use-system-tooltips-watcher (&rest _ignored) + "Variable watcher to force a menu bar update when `use-system-tooltip' changes. +This is necessary because on Haiku `use-system-tooltip' doesn't +take effect on menu items until the menu bar is updated again." + (force-mode-line-update t)) + +(add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher) + +(provide 'haiku-win) +(provide 'term/haiku-win) + +;;; haiku-win.el ends here |