From 0194e2ced5c528049fad436e2720aff864ff74ae Mon Sep 17 00:00:00 2001 From: defanor Date: Sat, 28 Oct 2017 02:01:46 +0300 Subject: Add pancake.el, an emacs interface - Relicense under GPLv3: pandoc is under GPLv2, it's expected of emacs packages to be under GPLv3, so it seems appropriate. - Add support for embedding (in particular, print s-expressions instead of escape sequences). - Add the emacs package. --- pancake.el | 262 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 262 insertions(+) create mode 100644 pancake.el (limited to 'pancake.el') diff --git a/pancake.el b/pancake.el new file mode 100644 index 0000000..33bbee0 --- /dev/null +++ b/pancake.el @@ -0,0 +1,262 @@ +;;; pancake.el --- Pancake browser interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 defanor + +;; Author: defanor +;; Maintainer: defanor +;; Created: 2017-10-28 +;; Keywords: pandoc, web, gopher, browser +;; Homepage: https://defanor.uberspace.net/projects/pancake/ +;; Version: 0.1.0 + +;; This file is not part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; This is a rather simple interface to the pancake browser. + +;;; Code: + +(require 'seq) + +(defgroup pancake nil + "Pancake browser interface." + :prefix "pancake-" + :group 'applications) + +(defface pancake-color-black-foreground + '((((type graphic) (class color) (background dark)) :foreground "grey") + (((type graphic) (class color) (background light)) :foreground "black") + (t :foreground "black")) + "Foreground face for black color." + :group 'pancake) + +(defface pancake-color-red-foreground + '((((type graphic) (class color) (background dark)) :foreground "light coral") + (((type graphic) (class color) (background light)) :foreground "dark red") + (t :foreground "red")) + "Foreground face for red color." + :group 'pancake) + +(defface pancake-color-green-foreground + '((((type graphic) (class color) (background dark)) :foreground "light green") + (((type graphic) (class color) (background light)) :foreground "dark green") + (t :foreground "green")) + "Foreground face for green color." + :group 'pancake) + +(defface pancake-color-yellow-foreground + '((((type graphic) (class color) (background dark)) :foreground "light yellow") + (((type graphic) (class color) (background light)) :foreground "yellow4") + (t :foreground "yellow")) + "Foreground face for yellow color." + :group 'pancake) + +(defface pancake-color-blue-foreground + '((((type graphic) (class color) (background dark)) :foreground "light blue") + (((type graphic) (class color) (background light)) :foreground "dark blue") + (t :foreground "blue")) + "Foreground face for blue color." + :group 'pancake) + +(defface pancake-color-magenta-foreground + '((((type graphic) (class color) (background dark)) :foreground "pink") + (((type graphic) (class color) (background light)) :foreground "magenta4") + (t :foreground "magenta")) + "Foreground face for magenta color." + :group 'pancake) + +(defface pancake-color-cyan-foreground + '((((type graphic) (class color) (background dark)) :foreground "light cyan") + (((type graphic) (class color) (background light)) :foreground "dark cyan") + (t :foreground "cyan")) + "Foreground face for cyan color." + :group 'pancake) + +(defface pancake-color-white-foreground + '((((type graphic) (class color) (background dark)) :foreground "white") + (((type graphic) (class color) (background light)) :foreground "grey") + (t :foreground "white")) + "Foreground face for white color." + :group 'pancake) + +(defcustom pancake-command '("pancake") + "A command that runs pancake, along with its arguments" + :group 'pancake) + +(defvar pancake-buffers '() + "A list of pancake browser buffers, used to find a buffer to + use by `pancake-browse-url'.") + +(defvar pancake-process-output "" + "Pancake process's stdout collector.") +(make-variable-buffer-local 'pancake-process-output) + +(defvar pancake-process-stderr-output "" + "Pancake process's stderr collector.") +(make-variable-buffer-local 'pancake-process-stderr-output) + +(defvar pancake-process nil + "Pancake browser process.") +(make-variable-buffer-local 'pancake-process) + +;;###autoload +(defun pancake () + "Run the pancake browser." + (interactive) + (let ((p-buf (generate-new-buffer "*pancake*"))) + (display-buffer p-buf) + (with-current-buffer p-buf + (pancake-mode) + (setq pancake-process + (let ((process-environment + (append + (list (format "TERM=%s" (if window-system "xterm" + (or (getenv "TERM") "dumb"))) + (format "INSIDE_EMACS=%s,pancake" emacs-version) + (format "COLUMNS=%d" (1- (window-width)))) + process-environment))) + (make-process + :name "pancake" + :buffer p-buf + :command pancake-command + :stderr (make-pipe-process + :name "*pancake-stderr*" + :filter 'pancake-process-stderr-filter + :sentinel 'pancake-process-stderr-sentinel) + :filter 'pancake-process-filter + :sentinel 'pancake-process-sentinel))) + (push p-buf pancake-buffers) + (read-only-mode 1)))) + +;;###autoload +(defun pancake-browse-url (url &optional new-session) + "Browse an URL with pancake, suitable for setting as +`browse-url-browser-function'." + (when (or new-session (not (consp pancake-buffers))) + (pancake)) + (with-current-buffer (car pancake-buffers) + (process-send-string pancake-process (concat url "\n")) + (display-buffer (current-buffer)))) + +(defun pancake-translate-color (name attr) + "Translate pancake colors into emacs faces." + (intern (concat "pancake-color-" + (downcase (symbol-name name)) + "-" + (symbol-name attr)))) + +(defun pancake-print-elem (element) + "Translate ELEMENT into a string." + (if (stringp element) + element + (pcase element + (`(fg (,color) . ,rest) + (let ((inner (pancake-print-line rest))) + (add-face-text-property + 0 (length inner) (pancake-translate-color color 'foreground) t inner) + inner)) + (`(bg (,color) . ,rest) + (let ((inner (pancake-print-line rest))) + (add-face-text-property + 0 (length inner) (pancake-translate-color color 'background) t inner) + inner)) + (`(style Bold . ,rest) + (let ((inner (pancake-print-line rest))) + (add-face-text-property 0 (length inner) 'bold t inner) + inner)) + (`(style Underline . ,rest) + (let ((inner (pancake-print-line rest))) + (add-face-text-property 0 (length inner) 'underline t inner) + inner)) + (`(style Italic . ,rest) + (let ((inner (pancake-print-line rest))) + (add-face-text-property 0 (length inner) 'italic t inner) + inner)) + (_ (format "%S" element))))) + + +(defun pancake-print-line (line) + "Translate LINE (a list of elements) into a string" + (apply 'concat (mapcar 'pancake-print-elem line))) + +(defun pancake-line-p (string) + "Return t if STRING ends with a newline character." + (char-equal (elt string (- (length string) 1)) ?\n)) + +(defun pancake-process-filter (proc string) + "Pancake process filter for stdout." + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (read-only-mode -1) + (delete-region (point-min) (point-max)) + (setq pancake-process-output (concat pancake-process-output string)) + (when (pancake-line-p pancake-process-output) + (dolist (line (read pancake-process-output)) + (insert (pancake-print-line line)) + (newline)) + (goto-char (point-min)) + (setq pancake-process-output "")) + (read-only-mode 1)))) + +(defun pancake-process-stderr-filter (proc string) + "Pancake process filter for stderr." + (setq pancake-process-stderr-output + (concat pancake-process-stderr-output string)) + (when (pancake-line-p pancake-process-stderr-output) + (message "pancake: %s" (string-trim pancake-process-stderr-output)) + (setq pancake-process-stderr-output ""))) + +(defun pancake-process-sentinel (process event) + "Pancake process sentinel for stdout." + (let ((buf (process-buffer process))) + (when (and (not (process-live-p process)) + (buffer-live-p (process-buffer process))) + (kill-buffer buf)) + (setq pancake-buffers + (seq-remove (lambda (x) (eq x buf)) pancake-buffers)))) + +(defun pancake-process-stderr-sentinel (process event) + "Pancake process sentinel for stderr." + (when (and (not (process-live-p process)) + (buffer-live-p (process-buffer process))) + (kill-buffer (process-buffer process)))) + +(defun pancake-input (char) + "Pancake input handler: opens minibuffer for input. +Sets the initial contents to CHAR, reads the rest, +and passes it to `pancake-process' as input." + (lambda () + (interactive) + (process-send-string + pancake-process + (concat (read-from-minibuffer "" (char-to-string char)) "\n")))) + +(defvar pancake-mode-map + (let ((map (make-sparse-keymap)) + (chars (append (number-sequence ?0 ?9) + (number-sequence ?a ?z)))) + (dolist (char chars) + (define-key map (char-to-string char) (pancake-input char))) + map) + "Keymap for `pancake-mode'.") + +(define-derived-mode pancake-mode nil "Pancake" + "A basic emacs interface to the pancake browser.") + +(provide 'pancake) + +;;; pancake.el ends here -- cgit v1.2.3