From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Ian Dunn Newsgroups: gmane.emacs.devel Subject: [ELPA] New package: slider-widget Date: Mon, 19 Feb 2018 13:02:52 -0500 Message-ID: <87vaesrh6b.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1519063432 16577 195.159.176.226 (19 Feb 2018 18:03:52 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 19 Feb 2018 18:03:52 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.91 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Feb 19 19:03:48 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1enpms-0003Yi-1f for ged-emacs-devel@m.gmane.org; Mon, 19 Feb 2018 19:03:38 +0100 Original-Received: from localhost ([::1]:51669 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1enpou-0002Ts-Au for ged-emacs-devel@m.gmane.org; Mon, 19 Feb 2018 13:05:44 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40678) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1enpo9-0002SZ-5C for emacs-devel@gnu.org; Mon, 19 Feb 2018 13:04:58 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1enpo8-0004eY-AN for emacs-devel@gnu.org; Mon, 19 Feb 2018 13:04:57 -0500 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35921) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1enpo8-0004eT-4s for emacs-devel@gnu.org; Mon, 19 Feb 2018 13:04:56 -0500 Original-Received: from [2604:6000:1006:8725:afb2:757c:dc05:6d23] (port=44864 helo=escafil) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1enpo7-0002d3-Ox for emacs-devel@gnu.org; Mon, 19 Feb 2018 13:04:56 -0500 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:222908 Archived-At: --=-=-= Content-Type: text/plain I'd like to submit slider-widget to ELPA. It's just a small package that adds support for an interactive slider widget. If there are no issues, I can push it straight to ELPA. --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=slider-widget.el Content-Transfer-Encoding: quoted-printable ;;; slider-widget.el --- Interactive slider widget -*- lexical-binding: t; = -*- ;; Copyright (c) 2018 Ian Dunn ;; Author: Ian Dunn ;; Maintainer: Ian Dunn ;; Keywords: Development, widgets ;; Version: 0.1 ;; Package-Requires: ((emacs "25.1")) ;; 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 Sof= tware ;; Foundation; either version 3, or (at your option) any later version. ;; This program is distributed in the hope that it will be useful, but WITH= OUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FI= TNESS ;; 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: ;; Widget for a slider: ;; ;; --------[]-------------- ;; ;; Create it like any other widget, using `widget-create' or the like. The= type ;; is 'slider. ;; ;; A slider has several properties: ;; ;; :background-string String to display in an inactive part of the slider= . In ;; the above example, the string is "--" (default). ;; ;; :cursor-string String for the cursor in the slider. In the above ;; example, it's "[]" (default). ;; ;; :progress-set Function to call when the value is interactively se= t. ;; By default, this is empty. ;; ;; :width Number of "background-strings" to use to create the ;; slider. This isn't necessarily the width in charac= ters ;; of the slider. The default is 15. ;; ;; The value of the slider is a float value between 0 and 1. ;;; Code: (eval-when-compile (require 'subr-x)) (require 'wid-edit) ;; A few examples; b is the number of bg-strs before the cursor, a is the n= umber ;; of strings after it. Width is 10. ;; 0%: []------------------ (b: 0, a:9) ;; 5%: []------------------ (b: 0, a:9) (Rounding Down) ;; 10%: --[]---------------- (b: 1, a:8) ;; 20%: ----[]-------------- (b: 2, a:7) ;; 30%: ------[]------------ (b: 3, a:6) ;; 40%: --------[]---------- (b: 4, a:5) ;; 50%: ----------[]-------- (b: 5, a:4) ;; Compatibility for Emacs < 26.1 (unless (fboundp 'when-let*) (defalias 'when-let* 'when-let)) (defun widget-slider-value-to-internal (widget progress) "Convert float PROGRESS to a string for WIDGET." (let* ((bg-str (widget-get widget :background-string)) (cursor-str (widget-get widget :cursor-string)) (width (widget-get widget :width)) (bg-before (floor (* progress width))) (bg-after (- width bg-before 1))) ;; -1 for the cursor (mapconcat 'identity (append (make-list bg-before bg-str) (list cursor-str) (make-list bg-after bg-str)) ""))) (defun widget-slider--convert (offset width bg-str-length) (let* ((bg-before (/ (float offset) (float bg-str-length)))) (/ bg-before (float width)))) (defun widget-slider-value-to-external (widget progress-string) (save-match-data (when-let* ((bg-str (widget-get widget :background-string)) (cursor-str (widget-get widget :cursor-string)) (width (widget-get widget :width)) (string-to-match (format "\\(\\(?:%s\\)*\\)%s\\(\\(?:%s\\)*= \\)" (regexp-quote bg-str) (regexp-quote cursor-str) (regexp-quote bg-str))) (pos (string-match string-to-match progress-string))) (widget-slider--convert (length (match-string 1 progress-string)) width (length bg-str))))) (defun widget-slider-notify (widget _changed &optional event) "Notification function for a slider widget, WIDGET. EVENT is the event that triggered it, if any." (let* ((from (widget-get widget :from)) (pos (if event (widget-event-point event) (point))) (width (widget-get widget :width)) (offset (- pos from)) (progress-set (widget-get widget :progress-set)) (bg-str (widget-get widget :background-string)) (progress (widget-slider--convert offset width (length bg-str)))) (widget-value-set widget progress) (when progress-set (funcall progress-set progress)))) ;; mouse-down-action is set for compatibility with the termux interface, wh= ich ;; doesn't send mouse-click events, just mouse-down. (define-widget 'slider 'item "Slider widget" :value-to-internal #'widget-slider-value-to-internal :value-to-external #'widget-slider-value-to-external :width 15 :notify #'widget-slider-notify :mouse-down-action (lambda (_wid &optional _event) t) :background-string "--" :cursor-string "[]" :progress-set #'ignore :format "%[%v%]") (provide 'slider-widget) ;;; slider-widget.el ends here --=-=-= Content-Type: text/plain -- Ian Dunn --=-=-=--