From 941164f258a43734cdcf565b55b7e8b1c178ff4d Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Thu, 15 Sep 2016 04:51:43 -0300 Subject: Import emacs-ctable_0.1.2.orig.tar.gz [dgit import orig emacs-ctable_0.1.2.orig.tar.gz] --- ctable.el | 1895 +++++++++++++++++++++++++++++++++++++++++++ img/async-model-sample1.png | Bin 0 -> 21278 bytes img/async-wrapper.png | Bin 0 -> 71892 bytes img/direx-ctable.png | Bin 0 -> 50977 bytes img/normal_use.png | Bin 0 -> 12979 bytes img/objects.png | Bin 0 -> 28803 bytes img/region-scratch.png | Bin 0 -> 18344 bytes img/sample-1-1.png | Bin 0 -> 3617 bytes img/sample-1-2.png | Bin 0 -> 3578 bytes img/sample-2-1.png | Bin 0 -> 15014 bytes readme.md | 431 ++++++++++ samples/direx-ctable.el | 135 +++ samples/large-table.el | 110 +++ samples/simple.el | 166 ++++ test-ctable.el | 249 ++++++ 15 files changed, 2986 insertions(+) create mode 100644 ctable.el create mode 100644 img/async-model-sample1.png create mode 100644 img/async-wrapper.png create mode 100644 img/direx-ctable.png create mode 100644 img/normal_use.png create mode 100644 img/objects.png create mode 100644 img/region-scratch.png create mode 100644 img/sample-1-1.png create mode 100644 img/sample-1-2.png create mode 100644 img/sample-2-1.png create mode 100644 readme.md create mode 100644 samples/direx-ctable.el create mode 100644 samples/large-table.el create mode 100644 samples/simple.el create mode 100644 test-ctable.el diff --git a/ctable.el b/ctable.el new file mode 100644 index 0000000..abfafef --- /dev/null +++ b/ctable.el @@ -0,0 +1,1895 @@ +;;; ctable.el --- Table component for Emacs Lisp + +;; Copyright (C) 2011, 2012, 2013, 2014 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; URL: https://github.com/kiwanami/emacs-ctable +;; Version: 0.1.2 +;; Keywords: table + +;; 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 program is a table component for Emacs Lisp. +;; Other programs can use this table component for the application UI. + +;;; Installation: + +;; Place this program in your load path and add following code. + +;; (require 'ctable) + +;;; Usage: + +;; Executing the command `ctbl:open-table-buffer', switch to the table buffer. + +;; Table data which are shown in the table view, are collected +;; by the `ctbl:model' objects. See the function `ctbl:demo' for example. +;; See the README document for the details. + +;;; Code: + +(eval-when-compile (require 'cl)) + + +;;; Models and Parameters + +(defstruct ctbl:model + "Table model structure + +data : Table data as a list of rows. A row contains a list of columns. + If an instance of `ctbl:async-model' is given, the model is built up asynchronously. +column-model : A list of column models. +sort-state : The current sort order as a list of column indexes. + The index number of the first column is 1. + If the index is negative, the sort order is reversed." + data column-model sort-state) + + +(defstruct ctbl:async-model + "Asynchronous data model + +request : Data request function which receives 4 arguments (begin-num length fn(row-list) fe(errmsg)). + This function should return the next data which begins with `begin-num' and has the length + as `length', evaluating the continuation function `fn' with the data. + If the function `fn' is given `nil', it means no more data. + If the error function `fe' is evaluated with `errmsg', the message is displayed for the user. +init-num : Initial row number. (Default 20) +more-num : Increase row number. (Default 20) +reset : Reset function which is called when user executes update command. (Can be nil) +cancel : Cancel function of data requesting. (Can be nil) + +For forward compatibility, these callback functions should have a `&rest' keyword at the end of argument list. +" + request (init-num 20) (more-num 20) reset cancel) + + +(defstruct ctbl:cmodel + "Table column model structure + +title : title string. +sorter : sorting function which transforms a cell value into sort value. + It should return -1, 0 and 1. If nil, `ctbl:sort-string-lessp' is used. +align : text alignment: 'left, 'right and 'center. (default: right) +max-width : maximum width of the column. if nil, no constraint. (default: nil) +min-width : minimum width of the column. if nil, no constraint. (default: nil) +click-hooks : a list of functions for header clicking with two arguments + the `ctbl:component' object and the `ctbl:cmodel' one. + (default: '(`ctbl:cmodel-sort-action'))" + title sorter align max-width min-width + (click-hooks '(ctbl:cmodel-sort-action))) + + +(defstruct ctbl:param + "Rendering parameters + +display-header : if t, display the header row with column models. +fixed-header : if t, display the header row in the header-line area. +bg-colors : '(((row-id . col-id) . colorstr) (t . default-color) ... ) or (lambda (model row-id col-id) colorstr or nil) +vline-colors : \"#RRGGBB\" or '((0 . colorstr) (t . default-color)) or (lambda (model col-index) colorstr or nil) +hline-colors : \"#RRGGBB\" or '((0 . colorstr) (t . default-color)) or (lambda (model row-index) colorstr or nil) +draw-vlines : 'all or '(0 1 2 .. -1) or (lambda (model col-index) t or nil ) +draw-hlines : 'all or '(0 1 2 .. -1) or (lambda (model row-index) t or nil ) +vertical-line horizontal-line : | - +left-top-corner right-top-corner left-bottom-corner right-bottom-corner : + +top-junction bottom-junction left-junction right-junction cross-junction : +" + display-header fixed-header + bg-colors vline-colors hline-colors draw-vlines draw-hlines vertical-line horizontal-line + left-top-corner right-top-corner left-bottom-corner right-bottom-corner + top-junction bottom-junction left-junction right-junction cross-junction) + +(defvar ctbl:completing-read 'completing-read + "Customize for completing-read function. + +To use `ido-completing-read', put the following sexp into your +Emacs init file: + +(eval-after-load 'ido + '(progn + (setq ctbl:completing-read 'ido-completing-read)))") + + +(defvar ctbl:default-rendering-param + (make-ctbl:param + :display-header t + :fixed-header nil + :bg-colors nil + :vline-colors "DarkGray" + :hline-colors "DarkGray" + :draw-vlines 'all + :draw-hlines '(1) + :vertical-line ?| + :horizontal-line ?- + :left-top-corner ?+ + :right-top-corner ?+ + :left-bottom-corner ?+ + :right-bottom-corner ?+ + :top-junction ?+ + :bottom-junction ?+ + :left-junction ?+ + :right-junction ?+ + :cross-junction ?+ + ) + "Default rendering parameters.") + +(defvar ctbl:tooltip-method '(pos-tip popup minibuffer) + "Preferred tooltip methods in order.") + +;;; Faces + +(defface ctbl:face-row-select + '((((class color) (background light)) + :background "WhiteSmoke") + (((class color) (background dark)) + :background "Blue4")) + "Face for row selection" :group 'ctable) + +(defface ctbl:face-cell-select + '((((class color) (background light)) + :background "Mistyrose1") + (((class color) (background dark)) + :background "Blue2")) + "Face for cell selection" :group 'ctable) + +(defface ctbl:face-continue-bar + '((((class color) (background light)) + :background "OldLace") + (((class color) (background dark)) + :background "Gray26")) + "Face for continue bar" :group 'ctable) + +;;; Utilities + +(defun ctbl:define-keymap (keymap-list &optional prefix) + "[internal] Keymap utility." + (let ((map (make-sparse-keymap))) + (mapc + (lambda (i) + (define-key map + (if (stringp (car i)) + (read-kbd-macro + (if prefix + (replace-regexp-in-string "prefix" prefix (car i)) + (car i))) + (car i)) + (cdr i))) + keymap-list) + map)) + +(defun ctbl:cell-id (row-id col-id) + "[internal] Create a cell-id object" + (cons row-id col-id)) + +(defun ctbl:tp (text prop value) + "[internal] Put a text property to the entire text string." + (if (< 0 (length text)) + (put-text-property 0 (length text) prop value text)) + text) + +(defvar ctbl:uid 1) + +(defun ctbl:uid () + "[internal] Generate an unique number." + (incf ctbl:uid)) + +(defun ctbl:fill-keymap-property (begin end keymap) + "[internal] Put the given text property to the region between BEGIN and END. +If the text already has some keymap property, the text is skipped." + (save-excursion + (goto-char begin) + (loop with pos = begin with nxt = nil + until (or (null pos) (<= end pos)) + when (get-text-property pos 'keymap) do + (setq pos (next-single-property-change pos 'keymap)) + else do + (setq nxt (next-single-property-change pos 'keymap)) + (when (null nxt) (setq nxt end)) + (put-text-property pos (min nxt end) 'keymap keymap)))) + +;; Model functions + +(defun ctbl:model-column-length (model) + "[internal] Return the column number." + (length (ctbl:model-column-model model))) + +(defun ctbl:model-row-length (model) + "[internal] Return the row number." + (length (ctbl:model-data model))) + +(defun ctbl:model-modify-sort-key (model col-index) + "Modify the list of sort keys for the column headers." + (let* ((sort-keys (ctbl:model-sort-state model)) + (col-key (1+ col-index))) + (cond + ((eq (car sort-keys) col-key) + (setf (ctbl:model-sort-state model) + (cons (- col-key) (cdr sort-keys)))) + ((eq (car sort-keys) (- col-key)) + (setf (ctbl:model-sort-state model) + (cons col-key (cdr sort-keys)))) + (t + (setf (ctbl:model-sort-state model) + (cons col-key (delete (- col-key) + (delete col-key sort-keys)))))) + (ctbl:model-sort-state model))) + +(defun ctbl:cmodel-sort-action (cp col-index) + "Sorting action for click on the column headers. +If data is an instance of `ctbl:async-model', this function do nothing." + (let* ((model (ctbl:cp-get-model cp))) + (unless (ctbl:async-model-p (ctbl:model-data model)) + (ctbl:model-modify-sort-key model col-index) + (ctbl:cp-update cp)))) + + +;;; ctable framework + +;; Component + +(defstruct ctbl:component + "Component + +This structure defines attributes of the table component. +These attributes are internal use. Other programs should access +through the functions of the component interface. + +dest : an object of `ctbl:dest' +model : an object of the table model +selected : selected cell-id: (row index . col index) +param : rendering parameter object +sorted-data : sorted data to display the table view. + see `ctbl:cp-get-selected-data-row' and `ctbl:cp-get-selected-data-cell'. +update-hooks : a list of hook functions for update event +selection-change-hooks : a list of hook functions for selection change event +click-hooks : a list of hook functions for click event +states : alist of arbitrary data for internal use" + dest model param selected sorted-data + update-hooks selection-change-hooks click-hooks states) + + +;; Rendering Destination + +(defstruct ctbl:dest + "Rendering Destination + +This structure object is the abstraction of the rendering +destinations, such as buffers, regions and so on. + +type : identify symbol for destination type. (buffer, region, text) +buffer : a buffer object of rendering destination. +min-func : a function that returns upper limit of rendering destination. +max-func : a function that returns lower limit of rendering destination. +width : width of the reference size. (number, nil or full) +height : height of the reference size. (number, nil or full) +clear-func : a function that clears the rendering destination. +before-update-func : a function that is called at the beginning of rendering routine. +after-update-func : a function that is called at the end of rendering routine. +select-ol : a list of overlays for selection" + type buffer min-func max-func width height + clear-func before-update-func after-update-func select-ol) + +(eval-when-compile + (defmacro ctbl:dest-with-region (dest &rest body) + (declare (debug (form &rest form))) + (let (($dest (gensym))) + `(let ((,$dest ,dest)) + (with-current-buffer (ctbl:dest-buffer ,$dest) + (save-restriction + (narrow-to-region + (ctbl:dest-point-min ,$dest) (ctbl:dest-point-max ,$dest)) + ,@body)))))) +(put 'ctbl:dest-with-region 'lisp-indent-function 1) + +(defun ctbl:dest-point-min (c) + (funcall (ctbl:dest-min-func c))) + +(defun ctbl:dest-point-max (c) + (funcall (ctbl:dest-max-func c))) + +(defun ctbl:dest-clear (c) + (funcall (ctbl:dest-clear-func c))) + +(defun ctbl:dest-before-update (c) + (when (ctbl:dest-before-update-func c) + (funcall (ctbl:dest-before-update-func c)))) + +(defun ctbl:dest-after-update (c) + (when (ctbl:dest-after-update-func c) + (funcall (ctbl:dest-after-update-func c)))) + + +;; Buffer + +(defconst ctbl:table-buffer-name "*ctbl-table*" "[internal] Default buffer name for the table view.") + +(defun ctbl:dest-init-buffer (&optional buf width height custom-map) + "Create a buffer destination. +This destination uses an entire buffer and set up the major-mode +`ctbl:table-mode' and the key map `ctbl:table-mode-map'. BUF is +a buffer name to render the table view. If BUF is nil, the +default buffer name is used. WIDTH and HEIGHT are reference size +of the table view. If those are nil, the size of table is +calculated from the window that shows BUF or the selected window. +The component object is stored at the buffer local variable +`ctbl:component'. CUSTOM-MAP is the additional keymap that is +added to default keymap `ctbl:table-mode-map'." + (lexical-let + ((buffer (or buf (get-buffer-create (format "*Table: %d*" (ctbl:uid))))) + (window (or (and buf (get-buffer-window buf)) (selected-window))) + dest) + (setq dest + (make-ctbl:dest + :type 'buffer + :min-func 'point-min + :max-func 'point-max + :buffer buffer + :width width + :height height + :clear-func (lambda () + (with-current-buffer buffer + (erase-buffer))))) + (with-current-buffer buffer + (unless (eq major-mode 'ctbl:table-mode) + (ctbl:table-mode custom-map))) + dest)) + +;; Region + +(defun ctbl:dest-init-region (buf mark-begin mark-end &optional width height) + "Create a region destination. The table is drew between +MARK-BEGIN and MARK-END in the buffer BUF. MARK-BEGIN and +MARK-END are separated by more than one character, such as a +space. This destination is employed to be embedded in the some +application buffer. Because this destination does not set up +any modes and key maps for the buffer, the application that uses +the ctable is responsible to manage the buffer and key maps." + (lexical-let + ((mark-begin mark-begin) (mark-end mark-end) + (window (or (get-buffer-window buf) (selected-window)))) + (make-ctbl:dest + :type 'region + :min-func (lambda () (marker-position mark-begin)) + :max-func (lambda () (marker-position mark-end)) + :buffer buf + :width width + :height height + :clear-func + (lambda () + (ctbl:dest-region-clear (marker-position mark-begin) + (marker-position mark-end)))))) + +(defun ctbl:dest-region-clear (begin end) + "[internal] Clear the content text." + (when (< 2 (- end begin)) + (delete-region begin (1- end))) + (goto-char begin)) + +;; Inline text + +(defconst ctbl:dest-background-buffer " *ctbl:dest-background*") + +(defun ctbl:dest-init-inline (width height) + "Create a text destination." + (lexical-let + ((buffer (get-buffer-create ctbl:dest-background-buffer)) + (window (selected-window)) + dest) + (setq dest + (make-ctbl:dest + :type 'text + :min-func 'point-min + :max-func 'point-max + :buffer buffer + :width width + :height height + :clear-func (lambda () + (with-current-buffer buffer + (erase-buffer))))) + dest)) + +;; private functions + +(defun ctbl:dest-ol-selection-clear (dest) + "[internal] Clear the selection overlays on the current table view." + (loop for i in (ctbl:dest-select-ol dest) + do (delete-overlay i)) + (setf (ctbl:dest-select-ol dest) nil)) + +(defun ctbl:dest-ol-selection-set (dest cell-id) + "[internal] Put a selection overlay on CELL-ID. The selection overlay can be + put on some cells, calling this function many times. This + function does not manage the selections, just put the overlay." + (lexical-let (ols (row-id (car cell-id)) (col-id (cdr cell-id))) + (ctbl:dest-with-region dest + (ctbl:find-all-by-row-id + dest row-id + (lambda (tcell-id begin end) + (let ((overlay (make-overlay begin end))) + (overlay-put overlay 'face + (if (= (cdr tcell-id) col-id) + 'ctbl:face-cell-select + 'ctbl:face-row-select)) + (push overlay ols))))) + (setf (ctbl:dest-select-ol dest) ols))) + + +;; Component implementation + +(defun ctbl:cp-new (dest model param) + "[internal] Create a new component object. +DEST is a ctbl:dest object. MODEL is a model object. PARAM is a +rendering parameter object. This function is called by the +initialization functions, `ctbl:create-table-component-buffer', +`ctbl:create-table-component-region' and `ctbl:get-table-text'." + (let ((cp (make-ctbl:component + :selected '(0 . 0) + :dest dest + :model model + :param (or param ctbl:default-rendering-param)))) + (ctbl:cp-update cp) + cp)) + +(defun ctbl:cp-get-component () + "Return the component object on the current cursor position. +Firstly, getting a text property `ctbl:component' on the current +position. If no object is found in the text property, the buffer +local variable `ctbl:component' is tried to get. If no object is +found at the variable, return nil." + (let ((component (get-text-property (point) 'ctbl:component))) + (unless component + (unless (local-variable-p 'ctbl:component (current-buffer)) + (error "Not found ctbl:component attribute...")) + (setq component (buffer-local-value 'ctbl:component (current-buffer)))) + component)) + +;; Component : getters + +(defun ctbl:cp-get-selected (component) + "Return the selected cell-id of the component." + (ctbl:component-selected component)) + +(defun ctbl:cp-get-selected-data-row (component) + "Return the selected row data. If no cell is selected, return nil." + (let* ((rows (ctbl:component-sorted-data component)) + (cell-id (ctbl:component-selected component)) + (row-id (car cell-id)) (col-id (cdr cell-id))) + (if row-id (nth row-id rows) nil))) + +(defun ctbl:cp-get-selected-data-cell (component) + "Return the selected cell data. If no cell is selected, return nil." + (let* ((rows (ctbl:component-sorted-data component)) + (cell-id (ctbl:component-selected component)) + (row-id (car cell-id)) (col-id (cdr cell-id))) + (if row-id + (nth col-id (nth row-id rows)) + nil))) + +(defun ctbl:cp-get-model (component) + "Return the model object." + (ctbl:component-model component)) + +(defun ctbl:cp-set-model (component model) + "Replace the model object and update the destination." + (setf (ctbl:component-model component) model) + (ctbl:cp-update component)) + +(defun ctbl:cp-get-param (component) + "Return a rendering parameter object." + (ctbl:component-param component)) + +(defun ctbl:cp-get-buffer (component) + "Return a buffer object on which the component draws the content." + (ctbl:dest-buffer (ctbl:component-dest component))) + +;; Component : setters + +(defun ctbl:cp-move-cursor (dest cell-id) + "[internal] Just move the cursor onto the CELL-ID. +If CELL-ID is not found, return nil. This function +is called by `ctbl:cp-set-selected-cell'." + (let ((pos (ctbl:find-by-cell-id dest cell-id))) + (cond + (pos + (goto-char pos) + (unless (eql (selected-window) (get-buffer-window (current-buffer))) + (set-window-point (get-buffer-window (current-buffer)) pos)) + t) + (t nil)))) + +(defun ctbl:cp-set-selected-cell (component cell-id) + "Select the cell on the component. If the current view doesn't contain the cell, +this function updates the view to display the cell." + (let ((last (ctbl:component-selected component)) + (dest (ctbl:component-dest component)) + (model (ctbl:component-model component))) + (when (ctbl:cp-move-cursor dest cell-id) + (setf (ctbl:component-selected component) cell-id) + (ctbl:dest-before-update dest) + (ctbl:dest-ol-selection-clear dest) + (ctbl:dest-ol-selection-set dest cell-id) + (ctbl:dest-after-update dest) + (unless (equal last cell-id) + (ctbl:cp-fire-selection-change-hooks component))))) + +;; Hook + +(defun ctbl:cp-add-update-hook (component hook) + "Add the update hook function to the component. +HOOK is a function that has no argument." + (push hook (ctbl:component-update-hooks component))) + +(defun ctbl:cp-add-selection-change-hook (component hook) + "Add the selection change hook function to the component. +HOOK is a function that has no argument." + (push hook (ctbl:component-selection-change-hooks component))) + +(defun ctbl:cp-add-click-hook (component hook) + "Add the click hook function to the component. +HOOK is a function that has no argument." + (push hook (ctbl:component-click-hooks component))) + +;; update + +(defun ctbl:cp-update (component) + "Clear and re-draw the component content." + (let* ((buf (ctbl:cp-get-buffer component)) + (dest (ctbl:component-dest component))) + (with-current-buffer buf + (ctbl:dest-before-update dest) + (ctbl:dest-ol-selection-clear dest) + (let (buffer-read-only) + (ctbl:dest-with-region dest + (ctbl:dest-clear dest) + (cond + ;; asynchronous model + ((ctbl:async-model-p + (ctbl:model-data (ctbl:component-model component))) + (lexical-let ((cp component)) + (ctbl:async-state-on-update cp) + (ctbl:render-async-main + dest + (ctbl:component-model component) + (ctbl:component-param component) + (lambda (rows &optional astate) + (setf (ctbl:component-sorted-data cp) rows) + (when astate + (ctbl:cp-states-set cp 'async-state astate)))))) + ;; synchronous model + (t + (setf (ctbl:component-sorted-data component) + (ctbl:render-main + dest + (ctbl:component-model component) + (ctbl:component-param component))))))) + (ctbl:cp-set-selected-cell + component (ctbl:component-selected component)) + (ctbl:dest-after-update dest) + (ctbl:cp-fire-update-hooks component)))) + +;; Component : privates + +(defun ctbl:cp-states-get (component key) + "[internal] Get a value from COMPONENT with KEY." + (cdr (assq key (ctbl:component-states component)))) + +(defun ctbl:cp-states-set (component key value) + "[internal] Set a value with KEY." + (let ((pair (assq key (ctbl:component-states component)))) + (cond + ((null pair) + (push (cons key value) (ctbl:component-states component))) + (t + (setf (cdr pair) value))))) + +(defun ctbl:cp-fire-click-hooks (component) + "[internal] Call click hook functions of the component with no arguments." + (loop for f in (ctbl:component-click-hooks component) + do (condition-case err + (funcall f) + (error (message "CTable: Click / Hook error %S [%s]" f err))))) + +(defun ctbl:cp-fire-selection-change-hooks (component) + "[internal] Call selection change hook functions of the component with no arguments." + (loop for f in (ctbl:component-selection-change-hooks component) + do (condition-case err + (funcall f) + (error (message "CTable: Selection change / Hook error %S [%s]" f err))))) + +(defun ctbl:cp-fire-update-hooks (component) + "[internal] Call update hook functions of the component with no arguments." + (loop for f in (ctbl:component-update-hooks component) + do (condition-case err + (funcall f) + (error (message "Ctable: Update / Hook error %S [%s]" f err))))) + +(defun ctbl:find-position-fast (dest cell-id) + "[internal] Find the cell-id position using bi-section search." + (let* ((row-id (car cell-id)) + (row-id-lim (max (- row-id 10) 0)) + (min (ctbl:dest-point-min dest)) + (max (ctbl:dest-point-max dest)) + (mid (/ (+ min max) 2))) + (save-excursion + (loop for next = (next-single-property-change mid 'ctbl:cell-id nil max) + for cur-row-id = (and next (car (ctbl:cursor-to-cell next))) + do + (cond + ((>= next max) (return (point))) + ((null cur-row-id) (setq mid next)) + ((= cur-row-id row-id) + (goto-char mid) (beginning-of-line) + (return (point))) + ((and (< row-id-lim cur-row-id) (< cur-row-id row-id)) + (goto-char mid) (beginning-of-line) (forward-line) + (return (point))) + ((< cur-row-id row-id) + (setq min mid) + (setq mid (/ (+ min max) 2))) + ((< row-id cur-row-id) + (setq max mid) + (setq mid (/ (+ min max) 2)))))))) + +(defun ctbl:find-by-cell-id (dest cell-id) + "[internal] Return a point where the text property `ctbl:cell-id' +is equal to cell-id in the current table view. If CELL-ID is not +found in the current view, return nil." + (loop with pos = (ctbl:find-position-fast dest cell-id) + with end = (ctbl:dest-point-max dest) + for next = (next-single-property-change pos 'ctbl:cell-id nil end) + for text-cell = (and next (ctbl:cursor-to-cell next)) + while (and next (< next end)) do + (if (and text-cell (equal cell-id text-cell)) + (return next)) + (setq pos next))) + +(defun ctbl:find-all-by-cell-id (dest cell-id func) + "[internal] Call the function FUNC in each regions where the +text-property `ctbl:cell-id' is equal to CELL-ID. The argument function FUNC +receives two arguments, begin position and end one. This function is +mainly used at functions for putting overlays." + (loop with pos = (ctbl:find-position-fast dest cell-id) + with end = (ctbl:dest-point-max dest) + for next = (next-single-property-change pos 'ctbl:cell-id nil end) + for text-id = (and next (ctbl:cursor-to-cell next)) + while (and next (< next end)) do + (if (and text-id (equal cell-id text-id)) + (let ((cend (next-single-property-change + next 'ctbl:cell-id nil end))) + (return (funcall func next cend)))) + (setq pos next))) + +(defun ctbl:find-all-by-row-id (dest row-id func) + "[internal] Call the function FUNC in each regions where the +row-id of the text-property `ctbl:cell-id' is equal to +ROW-ID. The argument function FUNC receives three arguments, +cell-id, begin position and end one. This function is mainly used +at functions for putting overlays." + (loop with pos = (ctbl:find-position-fast dest (cons row-id nil)) + with end = (ctbl:dest-point-max dest) + for next = (next-single-property-change pos 'ctbl:cell-id nil end) + for text-id = (and next (ctbl:cursor-to-cell next)) + while (and next (< next end)) do + (when text-id + (cond + ((equal row-id (car text-id)) + (let ((cend (next-single-property-change + next 'ctbl:cell-id nil end))) + (funcall func text-id next cend))) + ((< row-id (car text-id)) + (return nil)))) + (setq pos next))) + +(defun ctbl:find-first-cell (dest) + "[internal] Return the first cell in the current buffer." + (let ((pos (next-single-property-change + (ctbl:dest-point-min dest) 'ctbl:cell-id))) + (and pos (ctbl:cursor-to-cell pos)))) + +(defun ctbl:find-last-cell (dest) + "[internal] Return the last cell in the current buffer." + (let ((pos (previous-single-property-change + (ctbl:dest-point-max dest) 'ctbl:cell-id))) + (and pos (ctbl:cursor-to-cell (1- pos))))) + +(defun ctbl:cursor-to-cell (&optional pos) + "[internal] Return the cell-id at the cursor. If the text does not +have the text-property `ctbl:cell-id', return nil." + (get-text-property (or pos (point)) 'ctbl:cell-id)) + +(defun ctbl:cursor-to-nearest-cell () + "Return the cell-id at the cursor. If the point of cursor does +not have the cell-id, search the cell-id around the cursor +position. If the current buffer is not table view (it may be +bug), this function may return nil." + (or (ctbl:cursor-to-cell) + (let* ((r (lambda () (when (not (eolp)) (forward-char)))) + (l (lambda () (when (not (bolp)) (backward-char)))) + (u (lambda () (when (not (bobp)) (line-move 1)))) + (d (lambda () (when (not (eobp)) (line-move -1)))) + (dest (ctbl:component-dest (ctbl:cp-get-component))) + get) + (setq get (lambda (cmds) + (save-excursion + (if (null cmds) (ctbl:cursor-to-cell) + (ignore-errors + (funcall (car cmds)) (funcall get (cdr cmds))))))) + (or (loop for i in `((,d) (,r) (,u) (,l) + (,d ,r) (,d ,l) (,u ,r) (,u ,l) + (,d ,d) (,r ,r) (,u ,u) (,l ,l)) + for id = (funcall get i) + if id return id) + (cond + ((> (/ (point-max) 2) (point)) + (ctbl:find-first-cell dest)) + (t (ctbl:find-last-cell dest))))))) + + +;; Commands + +(defun ctbl:navi-move-gen (drow dcol) + "[internal] Move to the cell with the abstract position." + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id)) (col-id (cdr cell-id))) + (when (and cp cell-id) + (ctbl:navi-goto-cell (ctbl:cell-id (+ drow row-id) + (+ dcol col-id)))))) + +(defun ctbl:navi-move-up (&optional num) + "Move to the up neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen (- num) 0)) + +(defun ctbl:navi-move-down (&optional num) + "Move to the down neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen num 0)) + +(defun ctbl:navi-move-right (&optional num) + "Move to the right neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen 0 num)) + +(defun ctbl:navi-move-left (&optional num) + "Move to the left neighbor cell." + (interactive "p") + (unless num (setq num 1)) + (ctbl:navi-move-gen 0 (- num))) + +(defun ctbl:navi-move-left-most () + "Move to the left most cell." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id))) + (when (and cp cell-id) + (ctbl:navi-goto-cell (ctbl:cell-id row-id 0))))) + +(defun ctbl:navi-move-right-most () + "Move to the right most cell." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id)) + (model (ctbl:cp-get-model cp)) + (cols (ctbl:model-column-length model))) + (when (and cp cell-id) + (ctbl:navi-goto-cell (ctbl:cell-id row-id (1- cols)))))) + +(defun ctbl:navi-goto-cell (cell-id) + "Move the cursor to CELL-ID and put selection." + (let ((cp (ctbl:cp-get-component))) + (when cp + (ctbl:cp-set-selected-cell cp cell-id)))) + +(defun ctbl:navi-on-click () + "Action handler on the cells." + (interactive) + (let ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell))) + (when (and cp cell-id) + (ctbl:cp-set-selected-cell cp cell-id) + (ctbl:cp-fire-click-hooks cp)))) + +(defun ctbl:navi-jump-to-column () + "Jump to a specified column of the current row." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (cell-id (ctbl:cursor-to-nearest-cell)) + (row-id (car cell-id)) + (model (ctbl:cp-get-model cp)) + (cols (ctbl:model-column-length model)) + (col-names (mapcar 'ctbl:cmodel-title + (ctbl:model-column-model model))) + (completion-ignore-case t) + (col-name (funcall ctbl:completing-read "Column name: " col-names))) + (when (and cp cell-id) + (ctbl:navi-goto-cell + (ctbl:cell-id + row-id + (position col-name col-names :test 'equal)))))) + +(defun ctbl:action-update-buffer () + "Update action for the latest table model." + (interactive) + (let ((cp (ctbl:cp-get-component))) + (when cp + (ctbl:cp-update cp)))) + +(defun ctbl:action-column-header () + "Action handler on the header columns. (for normal key events)" + (interactive) + (ctbl:fire-column-header-action + (ctbl:cp-get-component) + (get-text-property (point) 'ctbl:col-id))) + +(defun ctbl:fire-column-header-action (cp col-id) + "[internal] Execute action handlers on the header columns." + (when (and cp col-id) + (loop with cmodel = (nth col-id (ctbl:model-column-model (ctbl:cp-get-model cp))) + for f in (ctbl:cmodel-click-hooks cmodel) + do (condition-case err + (funcall f cp col-id) + (error (message "Ctable: Header Click / Hook error %S [%s]" + f err)))))) + +(defun ctbl:render-column-header-keymap (col-id) + "[internal] Generate action handler on the header columns. (for header-line-format)" + (lexical-let ((col-id col-id)) + (let ((keymap (copy-keymap ctbl:column-header-keymap))) + (define-key keymap [header-line mouse-1] + (lambda () + (interactive) + (ctbl:fire-column-header-action (ctbl:cp-get-component) col-id))) + keymap))) + +(defvar ctbl:column-header-keymap + (ctbl:define-keymap + '(([mouse-1] . ctbl:action-column-header) + ("C-m" . ctbl:action-column-header) + ("RET" . ctbl:action-column-header) + )) + "Keymap for the header columns.") + +(defvar ctbl:table-mode-map + (ctbl:define-keymap + '( + ("k" . ctbl:navi-move-up) + ("j" . ctbl:navi-move-down) + ("h" . ctbl:navi-move-left) + ("l" . ctbl:navi-move-right) + + ("p" . ctbl:navi-move-up) + ("n" . ctbl:navi-move-down) + ("b" . ctbl:navi-move-left) + ("f" . ctbl:navi-move-right) + + ("c" . ctbl:navi-jump-to-column) + + ("e" . ctbl:navi-move-right-most) + ("a" . ctbl:navi-move-left-most) + + ("g" . ctbl:action-update-buffer) + + ([mouse-1] . ctbl:navi-on-click) + ("C-m" . ctbl:navi-on-click) + ("RET" . ctbl:navi-on-click) + + )) "Keymap for the table-mode buffer.") + +(defun ctbl:table-mode-map (&optional custom-map) + "[internal] Return a keymap object for the table buffer." + (cond + (custom-map + (set-keymap-parent custom-map ctbl:table-mode-map) + custom-map) + (t ctbl:table-mode-map))) + +(defvar ctbl:table-mode-hook nil + "This hook is called at end of setting up major mode `ctbl:table-mode'.") + +(defun ctbl:table-mode (&optional custom-map) + "Set up major mode `ctbl:table-mode'. + +\\{ctbl:table-mode-map}" + (kill-all-local-variables) + (setq truncate-lines t) + (use-local-map (ctbl:table-mode-map custom-map)) + (setq major-mode 'ctbl:table-mode + mode-name "Table Mode") + (setq buffer-undo-list t + buffer-read-only t) + (add-hook 'post-command-hook 'ctbl:start-tooltip-timer nil t) + (run-hooks 'ctbl:table-mode-hook)) + + +;; Rendering + +(defun ctbl:render-check-cell-width (rows cmodels column-widths) + "[internal] Return a list of rows. This function makes side effects: +cell widths are stored at COLUMN-WIDTHS, longer cell strings are truncated by +maximum width of the column models." + (loop for row in rows collect + (loop for c in row + for cm in cmodels + for cwmax = (ctbl:cmodel-max-width cm) + for i from 0 + for cw = (nth i column-widths) + for val = (format "%s" c) + collect + (progn + (when (and cwmax (< cwmax (string-width val))) + (setq val (truncate-string-to-width val cwmax))) + (when (< cw (string-width val)) + (setf (nth i column-widths) (string-width val))) + val)))) + +(defun ctbl:render-adjust-cell-width (cmodels column-widths total-width) + "[internal] Adjust column widths and return a list of column widths. +If TOTAL-WIDTH is nil, this function just returns COLUMN-WIDTHS. +If TOTAL-WIDTHS is shorter than sum of COLUMN-WIDTHS, this +function expands columns. The residual width is distributed over +the columns. If TOTAL-WIDTHS is longer than sum of +COLUMN-WIDTHS, this function shrinks columns to reduce the +surplus width." + (let ((init-total (loop for i in column-widths sum i))) + (cond + ((or (null total-width) + (= total-width init-total)) column-widths) + ((< total-width init-total) + (ctbl:render-adjust-cell-width-shrink + cmodels column-widths total-width init-total)) + (t + (ctbl:render-adjust-cell-width-expand + cmodels column-widths total-width init-total))))) + +(defun ctbl:render-adjust-cell-width-shrink (cmodels column-widths total-width init-total ) + "[internal] shrink column widths." + (let* ((column-widths (copy-sequence column-widths)) + (column-indexes (loop for i from 0 below (length cmodels) collect i)) + (residual (- init-total total-width))) + (loop for cnum = (length column-indexes) + until (or (= 0 cnum) (= 0 residual)) + do + (loop with ave-shrink = (max 1 (/ residual cnum)) + for idx in column-indexes + for cmodel = (nth idx cmodels) + for cwidth = (nth idx column-widths) + for min-width = (or (ctbl:cmodel-min-width cmodel) 1) + do + (cond + ((<= residual 0) (return)) ; complete + ((<= cwidth min-width) ; reject + (setq column-indexes (delete idx column-indexes))) + (t ; reduce + (let ((next-width (max 1 (- cwidth ave-shrink)))) + (incf residual (- next-width cwidth)) + (setf (nth idx column-widths) next-width)))))) + column-widths)) + +(defun ctbl:render-adjust-cell-width-expand (cmodels column-widths total-width init-total ) + "[internal] expand column widths." + (let* ((column-widths (copy-sequence column-widths)) + (column-indexes (loop for i from 0 below (length cmodels) collect i)) + (residual (- total-width init-total))) + (loop for cnum = (length column-indexes) + until (or (= 0 cnum) (= 0 residual)) + do + (loop with ave-expand = (max 1 (/ residual cnum)) + for idx in column-indexes + for cmodel = (nth idx cmodels) + for cwidth = (nth idx column-widths) + for max-width = (or (ctbl:cmodel-max-width cmodel) total-width) + do + (cond + ((<= residual 0) (return)) ; complete + ((<= max-width cwidth) ; reject + (setq column-indexes (delete idx column-indexes))) + (t ; expand + (let ((next-width (min max-width (+ cwidth ave-expand)))) + (incf residual (- cwidth next-width)) + (setf (nth idx column-widths) next-width)))))) + column-widths)) + +(defun ctbl:render-get-formats (cmodels column-widths) + "[internal] Return a list of the format functions." + (loop for cw in column-widths + for cm in cmodels + for al = (ctbl:cmodel-align cm) + collect + (lexical-let ((cw cw)) + (cond + ((eq al 'left) + (lambda (s) (ctbl:format-left cw s))) + ((eq al 'center) + (lambda (s) (ctbl:format-center cw s))) + (t + (lambda (s) (ctbl:format-right cw s))))))) + +(defun ctbl:render-choose-color (model param index) + "[internal] Choose rendering color." + (cond + ((null param) nil) + ((stringp param) param) + ((functionp param) + (funcall param model index)) + (t (let ((val (or (assq index param) + (assq t param)))) + (if val (cdr val) nil))))) + +(defun ctbl:render-bg-color (str row-id col-id model param) + "[internal] Return nil or the color string at the cell (row-id . cell-id)." + (let ((bgc-param (ctbl:param-bg-colors param))) + (cond + ((null bgc-param) nil) + ((functionp bgc-param) + (funcall bgc-param model row-id col-id str)) + (t + (let ((pair (or (assoc (cons row-id col-id) bgc-param) + (assoc t bgc-param)))) + (if pair (cdr pair) nil)))))) + +(defun ctbl:render-bg-color-put (str row-id col-id model param) + "[internal] Return the string with the background face." + (let ((bgcolor (ctbl:render-bg-color str row-id col-id model param))) + (if bgcolor + (let ((org-face (get-text-property 0 'face str))) + (propertize + (copy-sequence str) + 'face (if org-face + (append org-face (list ':background bgcolor)) + (list ':background bgcolor)))) + str))) + +(defun ctbl:render-line-color (str model param index) + "[internal] Return the propertize string." + (propertize (copy-sequence str) + 'face (list + ':foreground + (ctbl:render-choose-color model param index)))) + +(defun ctbl:render-vline-color (str model param index) + "[internal] Return the propertize string for vertical lines." + (ctbl:render-line-color str model (ctbl:param-vline-colors param) index)) + +(defun ctbl:render-hline-color (str model param index) + "[internal] Return the propertize string for horizontal lines." + (ctbl:render-line-color str model (ctbl:param-hline-colors param) index)) + +(defun ctbl:render-draw-vline-p (model param index) + "[internal] If a vertical line is needed at the column index, return t." + (cond + ((null param) nil) + ((eq 'all param) t) + ((functionp param) (funcall param model index)) + (t (and (consp param) (memq index param))))) + +(defun ctbl:render-draw-hline-p (model param index) + "[internal] If a horizontal line is needed at the row index, return t." + (cond + ((null param) nil) + ((eq 'all param) t) + ((functionp param) (funcall param model index)) + (t (memq index param)))) + +(defun ctbl:render-make-hline (column-widths model param index) + "[internal] " + (let ((vparam (ctbl:param-draw-vlines param)) + (hline (ctbl:param-horizontal-line param)) + left joint right) + (if (not (ctbl:render-draw-hline-p + model (ctbl:param-draw-hlines param) index)) + "" + (cond + ((eq 0 index) + (setq left (char-to-string (ctbl:param-left-top-corner param)) + joint (char-to-string (ctbl:param-top-junction param)) + right (char-to-string (ctbl:param-right-top-corner param)))) + ((eq -1 index) + (setq left (char-to-string (ctbl:param-left-bottom-corner param)) + joint (char-to-string (ctbl:param-bottom-junction param)) + right (char-to-string (ctbl:param-right-bottom-corner param)))) + (t + (setq left (char-to-string (ctbl:param-left-junction param)) + joint (char-to-string (ctbl:param-cross-junction param)) + right (char-to-string (ctbl:param-right-junction param))))) + (ctbl:render-hline-color + (concat + (if (ctbl:render-draw-vline-p model vparam 0) left) + (loop with ret = nil with endi = (length column-widths) + for cw in column-widths + for ci from 1 + for endp = (equal ci endi) + do + (push (make-string cw hline) ret) + (when (and (ctbl:render-draw-vline-p model vparam ci) + (not endp)) + (push joint ret)) + finally return (apply 'concat (reverse ret))) + (if (ctbl:render-draw-vline-p model vparam -1) right) + "\n") + model param index)))) + +(defun ctbl:render-join-columns (columns model param) + "[internal] Join a list of column strings with vertical lines." + (let (ret (V (char-to-string (ctbl:param-vertical-line param)))) + ;; left border line + (setq ret (if (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) 0) + (list (ctbl:render-vline-color V model param 0)) + nil)) + ;; content line + (loop with param-vl = (ctbl:param-draw-vlines param) + with param-vc = (ctbl:param-vline-colors param) + with endi = (length columns) + for i from 1 for endp = (equal i endi) + for cv in columns + for color = (ctbl:render-choose-color model param-vc i) + do + (push cv ret) + (when (and (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) i) + (not endp)) + (push (ctbl:render-vline-color V model param i) ret))) + ;; right border line + (when (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) -1) + (push (ctbl:render-vline-color V model param -1) ret)) + ;; join them + (mapconcat 'identity (reverse ret) ""))) + +(defun ctbl:render-sum-vline-widths (cmodels model param) + "[internal] Return a sum of the widths of vertical lines." + (let ((sum 0)) + ;; left border line + (when (ctbl:render-draw-vline-p model (ctbl:param-draw-vlines param) 0) + (incf sum)) + ;; content line + (loop with param-vl = (ctbl:param-draw-vlines param) + with endi = (length cmodels) + for i from 1 upto (length cmodels) + for endp = (equal i endi) do + (when (and (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) i) + (not endp)) + (incf sum))) + ;; right border line + (when (ctbl:render-draw-vline-p + model (ctbl:param-draw-vlines param) -1) + (incf sum)) + sum)) + +(defun ctbl:dest-width-get (dest) + "[internal] Return the column number to draw the table view. +Return nil, if the width is not given. Then, the renderer draws freely." + (let ((dwidth (ctbl:dest-width dest)) + (dwin (get-buffer-window))) + (cond + ((numberp dwidth) dwidth) + ((eq 'full dwidth) (window-width dwin)) + (t nil)))) + +(defun ctbl:dest-height-get (dest) + "[internal] Return the row number to draw the table view. +Return nil, if the height is not given. Then, the renderer draws freely." + (let ((dheight (ctbl:dest-height dest)) + (dwin (get-buffer-window))) + (cond + ((numberp dheight) dheight) + ((eq 'full dheight) (1- (window-height dwin))) + (t nil)))) + +(defun ctbl:render-main (dest model param) + "[internal] Rendering the table view. +This function assumes that the current buffer is the destination buffer." + (let* ((EOL "\n") drows + (cmodels (ctbl:model-column-model model)) + (rows (ctbl:sort + (copy-sequence (ctbl:model-data model)) cmodels + (ctbl:model-sort-state model))) + (column-widths + (loop for c in cmodels + for title = (ctbl:cmodel-title c) + collect (max (or (ctbl:cmodel-min-width c) 0) + (or (and title (length title)) 0)))) + column-formats) + ;; check cell widths + (setq drows (ctbl:render-check-cell-width rows cmodels column-widths)) + ;; adjust cell widths for ctbl:dest width + (when (ctbl:dest-width-get dest) + (setq column-widths + (ctbl:render-adjust-cell-width + cmodels column-widths + (- (ctbl:dest-width-get dest) + (ctbl:render-sum-vline-widths + cmodels model param))))) + (setq column-formats (ctbl:render-get-formats cmodels column-widths)) + (catch 'ctbl:insert-break + (when (ctbl:param-display-header param) + (ctbl:render-main-header dest model param + cmodels column-widths)) + (ctbl:render-main-content dest model param + cmodels drows column-widths column-formats)) + ;; return the sorted list + rows)) + +(defun ctbl:render-main-header (dest model param cmodels column-widths) + "[internal] Render the table header." + (let ((EOL "\n") + (header-string + (ctbl:render-join-columns + (loop for cm in cmodels + for i from 0 + for cw in column-widths + collect + (propertize + (ctbl:format-center cw (ctbl:cmodel-title cm)) + 'ctbl:col-id i + 'local-map (ctbl:render-column-header-keymap i) + 'mouse-face 'highlight)) + model param))) + (cond + ((and (eq 'buffer (ctbl:dest-type dest)) + (ctbl:param-fixed-header param)) + ;; buffer header-line + (let* ((fcol (/ (car (window-fringes)) + (frame-char-width))) + (header-text (concat (make-string fcol ? ) header-string))) + (setq header-line-format header-text) + ;; save header-text for hscroll updating + (set (make-local-variable 'ctbl:header-text) header-text))) + (t + ;; content area + (insert ; border line + (ctbl:render-make-hline column-widths model param 0)) + (insert header-string EOL) ; header columns + )))) + +(defun ctbl:render-main-content (dest model param cmodels rows + column-widths column-formats + &optional begin-index) + "[internal] Render the table content." + (unless begin-index + (setq begin-index 0)) + (let ((EOL "\n") (row-num (length rows))) + (loop for cols in rows + for row-index from begin-index + do + (insert + (ctbl:render-make-hline + column-widths model param (1+ row-index))) + (insert + (ctbl:render-join-columns + (loop for i in cols + for s = (if (stringp i) i (format "%s" i)) + for fmt in column-formats + for cw in column-widths + for col-index from 0 + for str = (ctbl:render-bg-color-put + (funcall fmt s) row-index col-index + model param) + collect + (propertize str + 'ctbl:cell-id (cons row-index col-index) + 'ctbl:cell-width cw)) + model param) EOL)) + ;; bottom border line + (insert + (ctbl:render-make-hline column-widths model param -1)))) + + +;; async data model + +(defvar ctbl:continue-button-keymap + (ctbl:define-keymap + '(([mouse-1] . ctbl:action-continue-async-clicked) + ("C-m" . ctbl:action-continue-async-clicked) + ("RET" . ctbl:action-continue-async-clicked) + )) + "Keymap for the continue button.") + +;; async data / internal state + +(defstruct ctbl:async-state + "Rendering State [internal] + +status : symbol -> + normal : data still remains. this is the start state. + requested : requested data and waiting for response. + done : no data remains. this is the final state. +actual-width : actual width +column-widths : width of each columns +column-formats : format of each columns +next-index : row index number for next request +panel-begin : begin mark object for status panel +panel-end : end mark object for status panel +" + status actual-width column-widths column-formats + next-index panel-begin panel-end) + +(defun ctbl:async-state-on-update (component) + "[internal] Reset async data model." + (let* ((cp component) + (amodel (ctbl:model-data (ctbl:cp-get-model cp))) + (astate (ctbl:cp-states-get cp 'async-state))) + (when (and astate (ctbl:async-model-reset amodel)) + (funcall (ctbl:async-model-reset amodel))))) + +(defun ctbl:async-state-on-click-panel (component) + "[internal] This function is called when the user clicks the status panel." + (let* ((cp component) + (amodel (ctbl:model-data (ctbl:cp-get-model cp))) + (astate (ctbl:cp-states-get cp 'async-state))) + (when cp + (case (ctbl:async-state-status astate) + ('normal + (ctbl:render-async-continue cp)) + ('requested + (when (ctbl:async-model-cancel amodel) + (funcall (ctbl:async-model-cancel amodel)) + (ctbl:async-state-update-status (ctbl:component-dest cp) 'normal))))))) + +(defun ctbl:async-state-update-status (component next-status) + "[internal] Update internal status of async-state and update the status panel." + (let* ((cp component) + (dest (ctbl:component-dest cp)) + (amodel (ctbl:model-data (ctbl:cp-get-model cp))) + (astate (ctbl:cp-states-get cp 'async-state))) + (with-current-buffer (ctbl:dest-buffer dest) + (setf (ctbl:async-state-status astate) next-status) + (ctbl:async-state-update-status-panel dest astate amodel)))) + +(defun ctbl:async-state-update-status-panel (dest astate amodel) + "[internal] Rendering data model status panel with current state." + (let ((begin (ctbl:async-state-panel-begin astate)) + (end (ctbl:async-state-panel-end astate)) + (width (ctbl:async-state-actual-width astate))) + (save-excursion + (let (buffer-read-only) + (when (< 2 (- end begin)) + (delete-region begin (1- end))) + (goto-char begin) + (insert + (propertize + (case (ctbl:async-state-status astate) + ('done + (ctbl:format-center width "No more data.")) + ('requested + (cond + ((ctbl:async-model-cancel amodel) + (ctbl:format-center width "(Waiting for data. [Click to Cancel])")) + (t + (ctbl:format-center width "(Waiting for data...)")))) + ('normal + (ctbl:format-center width "[Click to retrieve more data.]")) + (t + (ctbl:format-center + width (format "(Error : %s)" (ctbl:async-state-status astate))))) + 'keymap ctbl:continue-button-keymap + 'face 'ctbl:face-continue-bar + 'mouse-face 'highlight) + "\n"))))) + +(defun ctbl:async-state-on-post-command-hook (component) + "[internal] Try auto requesting for asynchronous data." + (let* ((astate (ctbl:cp-states-get component 'async-state)) + (panel-begin-pos (marker-position + (ctbl:async-state-panel-begin astate)))) + (when (and (eq 'normal (ctbl:async-state-status astate)) + (< panel-begin-pos (window-end))) + (ctbl:action-continue-async-clicked)))) + +;; rendering async data + +(defun ctbl:render-async-main (dest model param rows-setter) + "[internal] Rendering the table view for async data model. +This function assumes that the current buffer is the destination buffer." + (lexical-let* + ((dest dest) (model model) (param param) (rows-setter rows-setter) + (amodel (ctbl:model-data model)) (buf (current-buffer)) + (cmodels (ctbl:model-column-model model))) + (funcall + (ctbl:async-model-request amodel) + 0 (ctbl:async-model-init-num amodel) + (lambda (rows) ; >> request succeeded + (with-current-buffer buf + (let (buffer-read-only drows column-formats + (column-widths + (loop for c in cmodels + for title = (ctbl:cmodel-title c) + collect (max (or (ctbl:cmodel-min-width c) 0) + (or (and title (length title)) 0)))) + (EOL "\n")) + ;; check cell widths + (setq drows (ctbl:render-check-cell-width rows cmodels column-widths)) + ;; adjust cell widths for ctbl:dest width + (when (ctbl:dest-width-get dest) + (setq column-widths + (ctbl:render-adjust-cell-width + cmodels column-widths + (- (ctbl:dest-width-get dest) + (ctbl:render-sum-vline-widths + cmodels model param))))) + (setq column-formats (ctbl:render-get-formats cmodels column-widths)) + (ctbl:render-main-header dest model param cmodels column-widths) + (ctbl:render-main-content dest model param cmodels drows column-widths column-formats) + (add-hook 'post-command-hook 'ctbl:post-command-hook-for-auto-request t t) + (let (mark-panel-begin mark-panel-end astate) + (setq mark-panel-begin (point-marker)) + (insert "\n") + (setq mark-panel-end (point-marker)) + (setq astate + (make-ctbl:async-state + :status 'normal + :actual-width (+ (ctbl:render-sum-vline-widths cmodels model param) + (loop for i in column-widths sum i)) + :column-widths column-widths :column-formats column-formats + :next-index (length rows) + :panel-begin mark-panel-begin :panel-end mark-panel-end)) + (ctbl:async-state-update-status-panel dest astate amodel) + (funcall rows-setter rows astate)) + (goto-char (ctbl:dest-point-min dest))))) + (lambda (errsym) ; >> request failed + (message "ctable : error -> %S" errsym))))) + +(defun ctbl:render-async-continue (component) + "[internal] Rendering subsequent data asynchronously." + (lexical-let* + ((cp component) (dest (ctbl:component-dest cp)) (buf (current-buffer)) + (model (ctbl:cp-get-model cp)) + (amodel (ctbl:model-data model)) + (astate (ctbl:cp-states-get cp 'async-state)) + (begin-index (ctbl:async-state-next-index astate))) + ;; status update + (ctbl:async-state-update-status cp 'requested) + (condition-case err + (funcall ; request async data + (ctbl:async-model-request amodel) + begin-index (ctbl:async-model-more-num amodel) + (lambda (rows) ; >> request succeeded + (with-current-buffer buf + (save-excursion + (let (buffer-read-only) + (cond + ((null rows) + ;; no more data + (ctbl:async-state-update-status cp 'done)) + (t + ;; continue data + (goto-char (1- (marker-position (ctbl:async-state-panel-begin astate)))) + (insert "\n") + (ctbl:render-main-content + dest model (ctbl:cp-get-param cp) (ctbl:model-column-model model) + rows (ctbl:async-state-column-widths astate) + (ctbl:async-state-column-formats astate) begin-index) + (delete-backward-char 1) + (ctbl:async-state-update-status cp 'normal) + ;; append row data (side effect!) + (setf (ctbl:component-sorted-data cp) + (append (ctbl:component-sorted-data cp) rows)) + (setf (ctbl:async-state-next-index astate) + (+ (length rows) begin-index)))))))) + (lambda (errsym) ; >> request failed + (ctbl:async-state-update-status cp errsym))) + (error ; >> request synchronously failed + (ctbl:async-state-update-status cp (cadr err)) + (message "ctable : error -> %S" err))))) + +;; async data actions + +(defun ctbl:action-continue-async-clicked () + "Action for clicking the continue button." + (interactive) + (let ((cp (ctbl:cp-get-component))) + (when cp + (ctbl:async-state-on-click-panel cp)))) + +(defun ctbl:post-command-hook-for-auto-request () + "[internal] This hook watches the buffer position of displayed window +to urge async data model to request next data chunk." + (let ((cp (ctbl:cp-get-component))) + (when (and cp (not (window-minibuffer-p))) + (ctbl:async-state-on-post-command-hook cp)))) + +(defun ctbl:async-model-wrapper (rows &optional init-num more-num) + "This function wraps a list of row data in an asynchronous data +model so as to avoid Emacs freezing with a large number of rows." + (lexical-let ((rows rows) (rest-rows rows) + (init-num (or init-num 100)) + (more-num (or more-num 100))) + (make-ctbl:async-model + :request + (lambda (row-num len responsef errorf &rest ignored) + (funcall + responsef + (cond + ((null rest-rows) nil) + (t + (nreverse + (loop with pos = rest-rows + with ret = nil + for i from 0 below len + do + (push (car pos) ret) + (setq pos (cdr pos)) + (unless pos (return ret)) + finally return ret))))) + (when rest-rows + (setq rest-rows (nthcdr len rest-rows)))) + :reset + (lambda (&rest ignored) (setq rest-rows rows)) + :init-num init-num :more-num more-num))) + + +;; tooltip + +(defun ctbl:pop-tooltip (string) + "[internal] Show STRING in tooltip." + (cond + ((and (memq 'pos-tip ctbl:tooltip-method) window-system (featurep 'pos-tip)) + (pos-tip-show (ctbl:string-fill-paragraph string) + 'popup-tip-face nil nil 0)) + ((and (memq 'popup ctbl:tooltip-method) (featurep 'popup)) + (popup-tip string)) + ((memq 'minibuffer ctbl:tooltip-method) + (let ((message-log-max nil)) + (message string))))) + +(defun ctbl:show-cell-in-tooltip (&optional unless-visible) + "Show cell at point in tooltip. +When UNLESS-VISIBLE is non-nil, show tooltip only when data in +cell is truncated." + (interactive) + (let* ((cp (ctbl:cp-get-component)) + (data (when cp (ctbl:cp-get-selected-data-cell cp)))) + (when data + (let ((string (if (stringp data) data (format "%S" data))) + (width (get-text-property (point) 'ctbl:cell-width))) + (when (or (not unless-visible) + (and (integerp width) (>= (length string) width))) + (ctbl:pop-tooltip string)))))) + +(defvar ctbl:tooltip-delay 1) + +(defvar ctbl:tooltip-timer nil) + +(defun ctbl:start-tooltip-timer () + (unless ctbl:tooltip-timer + (setq ctbl:tooltip-timer + (run-with-idle-timer ctbl:tooltip-delay nil + (lambda () + (ctbl:show-cell-in-tooltip t) + (setq ctbl:tooltip-timer nil)))))) + + +;; Rendering utilities + +(defun ctbl:format-truncate (org limit-width &optional ellipsis) + "[internal] Truncate a string ORG with LIMIT-WIDTH, like `truncate-string-to-width'." + (setq org (replace-regexp-in-string "\n" " " org)) + (if (< limit-width (string-width org)) + (let ((str (truncate-string-to-width + (substring org 0) limit-width 0 nil ellipsis))) + (when (< limit-width (string-width str)) + (setq str (truncate-string-to-width (substring org 0) + limit-width))) + (setq str (propertize str 'mouse-face 'highlight)) + (unless (get-text-property 0 'help-echo str) + (setq str (propertize str 'help-echo org))) + str) + org)) + +(defun ctbl:format-right (width string &optional padding) + "[internal] Format STRING, padding on the left with the character PADDING." + (let* ((padding (or padding ?\ )) + (cnt (or (and string + (ctbl:format-truncate string width t)) + "")) + (len (string-width cnt)) + (margin (max 0 (- width len)))) + (concat (make-string margin padding) cnt))) + +(defun ctbl:format-center (width string &optional padding) + "[internal] Format STRING in the center, padding on the both +sides with the character PADDING." + (let* ((padding (or padding ?\ )) + (cnt (or (and string + (ctbl:format-truncate string width t)) + "")) + (len (string-width cnt)) + (margin (max 0 (/ (- width len) 2)))) + (concat + (make-string margin padding) cnt + (make-string (max 0 (- width len margin)) padding)))) + +(defun ctbl:format-left (width string &optional padding) + "[internal] Format STRING, padding on the right with the character PADDING." + (let* ((padding (or padding ?\ )) + (cnt (or (and string + (ctbl:format-truncate string width t)) + "")) + (len (string-width cnt)) + (margin (max 0 (- width len)))) + (concat cnt (make-string margin padding)))) + +(defun ctbl:sort-string-lessp (i j) + "[internal] String comparator." + (cond + ((string= i j) 0) + ((string< i j) -1) + (t 1))) + +(defun ctbl:sort-number-lessp (i j) + "[internal] Number comparator." + (cond + ((= i j) 0) + ((< i j) -1) + (t 1))) + +(defun ctbl:sort (rows cmodels orders) + "[internal] Sort rows according to order indexes and column models." + (let* + ((comparator + (lambda (ref) + (lexical-let + ((ref ref) + (f (or (ctbl:cmodel-sorter (nth ref cmodels)) + 'ctbl:sort-string-lessp))) + (lambda (i j) + (funcall f (nth ref i) (nth ref j)))))) + (negative-comparator + (lambda (ref) + (lexical-let ((cp (funcall comparator ref))) + (lambda (i j) (- (funcall cp i j)))))) + (to-bool + (lambda (f) + (lexical-let ((f f)) + (lambda (i j) + (< (funcall f i j) 0))))) + (chain + (lambda (fs) + (lexical-let ((fs fs)) + (lambda (i j) + (loop for f in fs + for v = (funcall f i j) + unless (eq 0 v) + return v + finally return 0)))))) + (sort rows + (loop with fs = nil + for o in (reverse (copy-sequence orders)) + for gen = (if (< 0 o) comparator negative-comparator) + for f = (funcall gen (1- (abs o))) + do (push f fs) + finally return (funcall to-bool (funcall chain fs)))))) + +(defun ctbl:string-fill-paragraph (string &optional justify) + "[internal] `fill-paragraph' against STRING." + (with-temp-buffer + (erase-buffer) + (insert string) + (goto-char (point-min)) + (fill-paragraph justify) + (buffer-string))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; CTable API + +;; buffer + +(defun* ctbl:open-table-buffer(&key buffer width height custom-map model param) + "Open a table buffer simply. +This function uses the function +`ctbl:create-table-component-buffer' internally." + (let ((cp (ctbl:create-table-component-buffer + :buffer buffer :width width :height height + :custom-map custom-map :model model :param param))) + (switch-to-buffer (ctbl:cp-get-buffer cp)))) + +(defun* ctbl:create-table-component-buffer(&key buffer width height custom-map model param) + "Return a table buffer with some customize parameters. + +This function binds the component object at the +buffer local variable `ctbl:component'. + +The size of table is calculated from the window that shows BUFFER or the selected window. +BUFFER is the buffer to be rendered. If BUFFER is nil, this function creates a new buffer. +CUSTOM-MAP is the additional keymap that is added to default keymap `ctbl:table-mode-map'." + (let* ((dest (ctbl:dest-init-buffer buffer width height custom-map)) + (cp (ctbl:cp-new dest model param))) + (setf (ctbl:dest-after-update-func dest) + (lambda () + (ctbl:dest-buffer-update-header))) + (with-current-buffer (ctbl:dest-buffer dest) + (set (make-local-variable 'ctbl:component) cp)) + cp)) + +(defun ctbl:dest-buffer-update-header () + "[internal] After auto hscrolling, update the horizontal position of the header line." + (run-at-time 0.01 nil 'ctbl:dest-buffer-update-header--deferred)) + +(defun ctbl:dest-buffer-update-header--deferred () + "[internal] Adjust header line position." + (when (boundp 'ctbl:header-text) + (let* ((left (window-hscroll)) + (text (substring ctbl:header-text left))) + (setq header-line-format text)) + (force-window-update (current-buffer)))) + + +(defun ctbl:popup-table-buffer-easy (rows &optional header-row) + "Popup a table buffer from a list of rows." + (pop-to-buffer (ctbl:create-table-buffer-easy rows header-row))) + +(defun ctbl:open-table-buffer-easy (rows &optional header-row) + "Open a table buffer from a list of rows." + (switch-to-buffer (ctbl:create-table-buffer-easy rows header-row))) + +(defun ctbl:create-table-buffer-easy (rows &optional header-row) + "Return a table buffer from a list of rows." + (ctbl:cp-get-buffer + (ctbl:create-table-component-buffer + :model (ctbl:make-model-from-list rows header-row)))) + +(defun ctbl:make-model-from-list (rows &optional header-row) + "Make a `ctbl:model' instance from a list of rows." + (let* ((col-num (or (and header-row (length header-row)) + (and (car rows) (length (car rows))))) + (column-models + (if header-row + (loop for i in header-row + collect (make-ctbl:cmodel :title (format "%s" i) :min-width 5)) + (loop for i from 0 below col-num + for ch = (char-to-string (+ ?A i)) + collect (make-ctbl:cmodel :title ch :min-width 5))))) + (make-ctbl:model + :column-model column-models :data rows))) + +;; region + +(defun* ctbl:create-table-component-region(&key width height keymap model param) + "Insert markers of the rendering destination at current point and display the table view. + +This function returns a component object and stores it at the text property `ctbl:component'. + +WIDTH and HEIGHT are reference size of the table view. If those are nil, the size is calculated from the selected window. +KEYMAP is the keymap that is put to the text property `keymap'. If KEYMAP is nil, `ctbl:table-mode-map' is used." + (let (mark-begin mark-end) + (setq mark-begin (point-marker)) + (insert " ") + (setq mark-end (point-marker)) + (save-excursion + (let* ((dest (ctbl:dest-init-region (current-buffer) mark-begin mark-end width height)) + (cp (ctbl:cp-new dest model param)) + (after-update-func + (lexical-let ((keymap keymap) (cp cp)) + (lambda () + (ctbl:dest-with-region (ctbl:component-dest cp) + (let (buffer-read-only) + (put-text-property (point-min) (1- (point-max)) + 'ctbl:component cp) + (ctbl:fill-keymap-property + (point-min) (1- (point-max)) + (or keymap ctbl:table-mode-map)))))))) + (setf (ctbl:dest-after-update-func dest) after-update-func) + (funcall after-update-func) + cp)))) + + +;; inline + +(defun* ctbl:get-table-text(&key width height model param) + "Return a text that is drew the table view. + +In this case, the rendering destination object is disposable. So, +one can not modify the obtained text with `ctbl:xxx' functions. + +WIDTH and HEIGHT are reference size of the table view." + (let* ((dest (ctbl:dest-init-inline width height)) + (cp (ctbl:cp-new dest model param)) + text) + (setq text + (with-current-buffer (ctbl:cp-get-buffer cp) + (buffer-substring (point-min) (point-max)))) + (kill-buffer (ctbl:cp-get-buffer cp)) + text)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Demo + +(defun ctbl:demo () + "Sample code for implementation for the table model." + (interactive) + (let ((param (copy-ctbl:param ctbl:default-rendering-param))) + ;; rendering parameters + ;;(setf (ctbl:param-display-header param) nil) + (setf (ctbl:param-fixed-header param) t) + (setf (ctbl:param-hline-colors param) + '((0 . "#00000") (1 . "#909090") (-1 . "#ff0000") (t . "#00ff00"))) + (setf (ctbl:param-draw-hlines param) + (lambda (model row-index) + (cond ((memq row-index '(0 1 -1)) t) + (t (= 0 (% (1- row-index) 5)))))) + (setf (ctbl:param-bg-colors param) + (lambda (model row-id col-id str) + (cond ((string-match "CoCo" str) "LightPink") + ((= 0 (% (1- row-index) 2)) "Darkseagreen1") + (t nil)))) + (let ((cp + (ctbl:create-table-component-buffer + :width nil :height nil + :model + (make-ctbl:model + :column-model + (list (make-ctbl:cmodel + :title "A" :sorter 'ctbl:sort-number-lessp + :min-width 5 :align 'right) + (make-ctbl:cmodel + :title "Title" :align 'center + :sorter (lambda (a b) (ctbl:sort-number-lessp (length a) (length b)))) + (make-ctbl:cmodel + :title "Comment" :align 'left)) + :data + '((1 "Bon Tanaka" "8 Year Curry." 'a) + (2 "Bon Tanaka" "Nan-ban Curry." 'b) + (3 "Bon Tanaka" "Half Curry." 'c) + (4 "Bon Tanaka" "Katsu Curry." 'd) + (5 "Bon Tanaka" "Gyu-don." 'e) + (6 "CoCo Ichi" "Beaf Curry." 'f) + (7 "CoCo Ichi" "Poke Curry." 'g) + (8 "CoCo Ichi" "Yasai Curry." 'h) + (9 "Berkley" "Hamburger Curry." 'i) + (10 "Berkley" "Lunch set." 'j) + (11 "Berkley" "Coffee." k)) + :sort-state + '(2 1) + ) + :param param))) + (ctbl:cp-add-click-hook + cp (lambda () (message "CTable : Click Hook [%S]" + (ctbl:cp-get-selected-data-row cp)))) + (ctbl:cp-add-selection-change-hook cp (lambda () (message "CTable : Select Hook"))) + (ctbl:cp-add-update-hook cp (lambda () (message "CTable : Update Hook"))) + (switch-to-buffer (ctbl:cp-get-buffer cp))))) + +;; (progn (eval-current-buffer) (ctbl:demo)) + +(provide 'ctable) +;;; ctable.el ends here diff --git a/img/async-model-sample1.png b/img/async-model-sample1.png new file mode 100644 index 0000000..b8b2c1b Binary files /dev/null and b/img/async-model-sample1.png differ diff --git a/img/async-wrapper.png b/img/async-wrapper.png new file mode 100644 index 0000000..e89a1a6 Binary files /dev/null and b/img/async-wrapper.png differ diff --git a/img/direx-ctable.png b/img/direx-ctable.png new file mode 100644 index 0000000..5960977 Binary files /dev/null and b/img/direx-ctable.png differ diff --git a/img/normal_use.png b/img/normal_use.png new file mode 100644 index 0000000..794112f Binary files /dev/null and b/img/normal_use.png differ diff --git a/img/objects.png b/img/objects.png new file mode 100644 index 0000000..13f98ba Binary files /dev/null and b/img/objects.png differ diff --git a/img/region-scratch.png b/img/region-scratch.png new file mode 100644 index 0000000..7307456 Binary files /dev/null and b/img/region-scratch.png differ diff --git a/img/sample-1-1.png b/img/sample-1-1.png new file mode 100644 index 0000000..ef07b44 Binary files /dev/null and b/img/sample-1-1.png differ diff --git a/img/sample-1-2.png b/img/sample-1-2.png new file mode 100644 index 0000000..20753d7 Binary files /dev/null and b/img/sample-1-2.png differ diff --git a/img/sample-2-1.png b/img/sample-2-1.png new file mode 100644 index 0000000..1bf9041 Binary files /dev/null and b/img/sample-2-1.png differ diff --git a/readme.md b/readme.md new file mode 100644 index 0000000..27666af --- /dev/null +++ b/readme.md @@ -0,0 +1,431 @@ +# Table Component for elisp + +`ctable.el` is a table component for emacs lisp. Emacs lisp programs can display a nice table view from an abstract data model. +The many emacs programs have the code for displaying table views, such as `dired`, `list-process`, `buffer-list` and so on. So, ctable.el would provide functions and a table framework for the table views. + +# Installation + +To use this program, locate this file to load-path directory, +and add the following code to your program code. + +```lisp +(require 'ctable) +``` + +# Quick Start + +## Hello World + +Giving a list of the rows list to the function `ctbl:popup-table-buffer-easy', a simple table buffer is popped out. + +```lisp +(ctbl:popup-table-buffer-easy + '((1 2 3 4) (5 6 7 8) (9 10 11 12))) +``` + +Here is the result image. The header titles are generated automatically. + +![sample-1-1](img/sample-1-1.png) + + +Giving two lists, the latter list is displayed at header titles. + +```lisp +(ctbl:popup-table-buffer-easy + '((1 2 3 4) (5 6 7 8) (9 10 11 12)) + '(aaa bbb ccc ddd)) +``` + +Here is the result image. + +![sample-1-2](img/sample-1-2.png) + +## Basic Use + +The objects of ctable are designed by the MVC pattern. Programmers can customize ctable objects to use rich table views in the applications easily. + +First, one defines the column model and data model for the user application. The former model defines how the column should be display, the latter one does the contents to display. + +Second, one chooses builds the view component with the models. + +Here is an illustration for the object relations in this basic case. + +![Object relations](img/normal_use.png) + +Here is a sample code for the model and view. + +```lisp +(let* ((column-model ; column model + (list (make-ctbl:cmodel + :title "A" :sorter 'ctbl:sort-number-lessp + :min-width 5 :align 'right) + (make-ctbl:cmodel + :title "Title" :align 'center + :sorter (lambda (a b) (ctbl:sort-number-lessp (length a) (length b)))) + (make-ctbl:cmodel + :title "Comment" :align 'left))) + (data + '((1 "Bon Tanaka" "8 Year Curry." 'a) + (2 "Bon Tanaka" "Nan-ban Curry." 'b) + (3 "Bon Tanaka" "Half Curry." 'c) + (4 "Bon Tanaka" "Katsu Curry." 'd) + (5 "Bon Tanaka" "Gyu-don." 'e) + (6 "CoCo Ichi" "Beaf Curry." 'f) + (7 "CoCo Ichi" "Poke Curry." 'g) + (8 "CoCo Ichi" "Yasai Curry." 'h) + (9 "Berkley" "Hamburger Curry." 'i) + (10 "Berkley" "Lunch set." 'j) + (11 "Berkley" "Coffee." k))) + (model ; data model + (make-ctbl:model + :column-model column-model :data data)) + (component ; ctable component + (ctbl:create-table-component-buffer + :model model))) + (pop-to-buffer (ctbl:cp-get-buffer component))) +``` + +Here is the result image. + +![sample-2-1](img/sample-2-1.png) + + +The models have further options and functions to customize the display and behavior, such as column width, text alignment, sorting and so on. (See Model section) + +The key-binding on the table can be customized by the keymap object in the usual way. Then, the user program implements the custom function which refers the focused cell. (See Key Bindings section) + +The ctable framework provides some hooks to notify the usual events: click, selection change and update view. (See Event Handling section) + +The appearance of the table can be customized, such as foreground and background color, tabular lines. (See Display Parameter section) + +![ctable components](img/objects.png) + +## Sample Codes + +- samples/simple.el + - sample codes mentioned above. +- samples/large-table.el + - large data and async-model samples. +- samples/direx-ctable.el + - directory tree and table list in collaboration with direx.el + - ref: https://github.com/m2ym/direx-el + +![direx-ctable image](img/direx-ctable.png) + + +# Advanced Topics + +## Column Model + +The struct `ctbl:cmodel` is a data type defined by cl-defstruct. This model defines how to display the content along with the each column. + +Here is the details of the slot members of `ctbl:cmodel`. + +|slot name | description | +|-----|------------------| +|title | **[required]** column header title string. | +|sorter | sorting function which transforms a cell value into sort value. It should return -1, 0 and 1. If nil, `ctbl:sort-string-lessp` is used. | +|align | text alignment: `left`, `right` and `center`. (default: `right`) | +|max-width | maximum width of the column. if `nil`, no constraint. (default: `nil`) | +|min-width | minimum width of the column. if `nil`, no constraint. (default: `nil`) | +|click-hooks | header click hook. a list of functions with two arguments the `ctbl:component` object and the `ctbl:cmodel` one. (default: '(ctbl:cmodel-sort-action)) | + +## Data Model + +The struct `ctbl:model` is a data type defined by cl-defstruct. This model defines contents to display with column models. + +Here is the details of the slot members of `ctbl:model`. + +|slot name | description | +|-----|------------------| +|data | **[required]** Table data as a list of rows. A row contains a list of columns. Or, an instance of `ctbl:async-model`. (See the async-model section for details.) | +|column-model | **[required]** A list of column models. | +|sort-state | The current sort order as a list of column indexes. The index number of the first column is 1. If the index is negative, the sort order is reversed. | + +## Key Bindings + +The keymap `ctbl:table-mode-map` is used as a default keymap on the table. This keymap is a customization variable for the end users, so it should not be modified by applications. + +The component functions `ctbl:create-table-component-buffer` and `ctbl:open-table-buffer` receive a `custom-map` argument to override the keymap on the table buffer. Because the functions connect the given keymap to the default keymap `ctbl:table-mode-map` as parent, application program may define the overriding entries. + +The component function `ctbl:create-table-component-region` receives a `keymap` argument to define the keymap on the each characters in the table region. + +The ctable framework provides some hooks for the usual event cases. In such cases, the application should use the event handlers, instead of defining the keymap. See the next section. + +## Event Handling + +The ctable provides some hooks for the particular events: clicking, selection changing and updating view. The application program can implement some actions without defining keymaps. + +Here is a sample code for the click action: + +```lisp +(ctbl:cp-add-click-hook + cp (lambda () (message "CTable : Click Hook [%S]" + (ctbl:cp-get-selected-data-row cp)))) +``` + +where, `cp` is an instance of `ctbl:component`. The function `ctbl:cp-add-click-hook` adds the given function as an event handler to the component instance. Here are event handler functions: + +- `ctbl:cp-add-click-hook` : on click +- `ctbl:cp-add-selection-change-hook` : on selection change +- `ctbl:cp-add-update-hook` : on update view + +The function `ctbl:cp-get-selected-data-row` returns a row object which is defined by the model. +Some component access functions are useful for the action handlers. + +- `ctbl:cp-get-selected` : returns a Cell-ID object which is currently selected, such as (1 . 2). +- `ctbl:cp-get-selected-data-row` : returns a row data which is currently selected. +- `ctbl:cp-get-selected-data-cell` : return a cell data which is currently selected. + +## Display Parameter + +The ctable renders tabular form with many rendering parameters. The parameters are set at the slot members of the cl-defstruct `ctbl:param`. + +To customize the parameters, one should copy the default parameters like `(copy-ctbl:param ctbl:default-rendering-param)` and set parameters with setter functions. Then, at the building ctable component instance, this parameter object is given by the `:param` keyword. + +Here is a sample code for parameter customize. + +```lisp + (let ((param (copy-ctbl:param ctbl:default-rendering-param))) + (setf (ctbl:param-fixed-header param) t) + (setf (ctbl:param-hline-colors param) + '((0 . "#00000") (1 . "#909090") (-1 . "#ff0000") (t . "#00ff00"))) + (setf (ctbl:param-draw-hlines param) + (lambda (model row-index) + (cond ((memq row-index '(0 1 -1)) t) + (t (= 0 (% (1- row-index) 5)))))) + (setf (ctbl:param-bg-colors param) + (lambda (model row-id col-id str) + (cond ((string-match "CoCo" str) "LightPink") + ((= 0 (% (1- row-index) 2)) "Darkseagreen1") + (t nil)))) + ... + (setq cp (ctbl:create-table-component-buffer + :model model :param param)) + ... + ) +``` + +Here is the details of the slot members of `ctbl:param`. + +|slot name | description | +|-----|------------------| +|display-header | if t, display the header row with column models. | +|fixed-header | if t, display the header row in the header-line area. | +|bg-colors | '(((row-id . col-id) . colorstr) (t . default-color) ... ) or (lambda (model row-id col-id) colorstr or nil) | +|vline-colors | "#RRGGBB" or '((0 . colorstr) (t . default-color)) or (lambda (model col-index) colorstr or nil) | +|hline-colors | "#RRGGBB" or '((0 . colorstr) (t . default-color)) or (lambda (model row-index) colorstr or nil) | +|draw-vlines | 'all or '(0 1 2 .. -1) or (lambda (model col-index) t or nil ) | +|draw-hlines | 'all or '(0 1 2 .. -1) or (lambda (model row-index) t or nil ) | +|vertical-line | vertical line character | +|horizontal-line | horizontal line character | +|left-top-corner | corner character | +|right-top-corner | corner character | +|left-bottom-corner | corner character | +|right-bottom-corner | corner character | +|top-junction | junction character | +|bottom-junction | junction character | +|left-junction | junction character | +|right-junction | junction character | +|cross-junction | junction character | + +## View Components + +Ctable has three destination components to display the tabular data. + +- Independent buffer +- Region in the other buffer +- Text output + +### Buffer + +The 'buffer' destination displays the tabular view as ordinary Emacs applications do. + +The function `ctbl:open-table-buffer` makes a new ctable buffer and displays it by `switch-to-buffer`. The major mode of the ctable buffer is `ctbl:table-mode` and the keymap `ctbl:table-mode-map` is bound. + +Using this destination with the `fixed-header` parameter, the application can use the fixed column header. + +This destination is easy to use for applications and users, because the buffer is usual application boundary and users know how to use buffers. + +### Region + +The 'Region' destination embeds the tabular view in the buffer which is managed by the other applications. This destination can give the other applications a nice tabular view. + +Let's try a simple demonstration. Evaluate this code in your scratch buffer. + +Region destination example: + + ;; Evaluate this code in the scratch buffer + (require 'ctable) + (ctbl:create-table-component-region + :model (ctbl:make-model-from-list + '((1 2 3 4) (5 6 7 8) (9 10 11 12)))) + +Then, the tabular view will be embedded in the scratch buffer. You can navigate the ctable view in the buffer. Undoing for the some times, you can remove the ctable view. + +![ctable in scratch buffer](img/region-scratch.png) + +Because this destination never interacts anything out of the region and has its own key-binds as a text property, users can easily embed a tabular view in the other applications. + +### Text + +The 'text' destination generates just a text which represent ctable view. The function `ctbl:get-table-text` returns the text. + +### Column Width + +TODO... + +- Unlimited mode +- Limited mode + - expand strategy + - shrink strategy + +## ctable Component + +An instance of struct `ctbl:component` manages all ctable states, such as models, view, event handlers and some internal status. If an application wants to interact a ctable component, the application should hold the instance and access the component through the following ctable component interface. + +### Getting ctbl:component Instance + +To access ctable component, the application program should bring an instance of `ctbl:component`. + +The instance of the ctable component is stored at following places: + +- `buffer` view: the buffer-local variable `ctbl:component` +- `region` view: the text property `ctbl:component` +- `text` view: N/A + +Calling the utility function `ctbl:cp-get-component`, one can obtain the ctable instance at the appropriate places. The stateless functions, such as simple event handler functions, can use this function to get the instance. + +The applications those have the state-full operations, however, should hold their own ctable instance for the safety object reference. + +### Access Internal Objects + +The application can get some internal objects. + +- model object : `ctbl:cp-get-model` +- parameter object : `ctbl:cp-get-param` +- buffer object : `ctbl:cp-get-buffer` + +### Cursor Position + +The application can get the current cursor position and modify the position. + +Here, *cell-id* is an object that represents the physical cursor position. *cell-id* is a cons pair which consists of positive integers: `(row . column)`. The index number begins from zero. One can access the values with `car` and `cdr` directly. + +- getting cell-id : `ctbl:cp-get-selected` +- moving cursor to cell-id : `ctbl:cp-set-selected-cell` + +Note that the position which is indicated by *cell-id* is not the same as the position of the model's row. Because the ctable component changes the row order with sorting by clicking header column, the rows order is not corresponding to the model's ones. + +If the application need to get the selected row's data, following functions are available: + +- current row data : `ctbl:cp-get-selected-data-row` +- current cell data : `ctbl:cp-get-selected-data-cell` + +### Modifying Model and Update Table View + +The application can update the table contents. + +Creating a new model instance and setting it to the component with `ctbl:cp-set-model`, the component replaces the model and refresh the buffer. + +- replace model instance and update view : `ctbl:cp-set-model` + +Another way is updating model instance destructively and refresh the buffer with `ctbl:cp-update`. If the modification of model data is little, this way is lightweight in the viewpoint of calculation and memory usage. However, such the destructive modification complicates the application logic. + +- update view with current model state : `ctbl:cp-update` + +## Async-Model and Incremental Update + +Ctable has incremental data interface which enables the application delay rendering or append subsequent data with the user action. This mechanism can avoid Emacs freezing during visualizing a large amount of data. + +### Case 1: Huge Data + +When a model which consists of a large number of rows (more than ~1000) is given to the synchronous interface mentioned above, Emacs blocks UI response until rendering is completed. Because the text rendering on the buffer is the heaviest task in ctable, it is effective that the application displays a front part of data and delays the rendering of rest data. In the most cases, users are interesting in the such first page of the large data. + +Just wrapping data in async-model via `ctbl:async-model-wrapper`, the application can use this interface. + +Here is a sample code: + +```lisp + (let* ((large-data ; large data : 4000 rows + (loop with lim = 4000 + for i from 0 upto lim + for d = (/ (random 1000) 1000.0) + collect + (list i d (exp (- (/ i 1.0 lim))) (exp (* (- (/ i 1.0 lim)) d))))) + (async-model ; wrapping a large data in async-data-model + (ctbl:async-model-wrapper large-data)) + (cp ; just build a component + (ctbl:create-table-component-buffer + :model + (make-ctbl:model + :column-model + (list (make-ctbl:cmodel :title "row") + (make-ctbl:cmodel :title "delta") + (make-ctbl:cmodel :title "exp") + (make-ctbl:cmodel :title "exp-delta")) + :data async-model)))) + (pop-to-buffer (ctbl:cp-get-buffer cp))) +``` + +And here is the result image: + +![async data wrapper](img/async-wrapper.png) + + +### Case 2: Asynchronous Retrieving + +In the case of retrieving large data asynchronously from an another process or remote servers, the application needs to append retrieved partial data without blocking UI response nor updating whole table view. + +Defining some functions in `ctbl:async-model` struct, the application can control asynchronous data retrieving and updating table view. + +Here is a minimum sample code: + +```lisp +(defun async-response (row-num len responsef errorf &rest a) + (funcall responsef + (loop for i from row-num below (+ row-num len) + collect + (list i (* i i) (* i i i) (sqrt i))))) + +(ctbl:open-table-buffer-easy + (make-ctbl:async-model :request 'async-response) ; defining async-model + '("int" "square" "cube" "root")) +``` + +In this sample code, we defined just a `request` function in `ctbl:async-model`. +The `request` function should have 4 arguments: + +- `row-num` : an index number of the requested first row +- `len` : a number of requested rows +- `responsef` : the continuation function to which the result rows should be passed +- `errorf` : the error continuation function + +Here is the result image: + +![defining async model:1](img/async-model-sample1.png) + +#### ctbl:async-model struct + +|slot name | description | +|-----|------------------| +|request | Data request function mentioned above. | +|init-num | Initial row number. (Default 20) | +|more-num | Increase row number. (Default 20) | +|reset | Reset function which is called when user executes update command. (Can be nil) | +|cancel | Cancel function of data requesting. (Can be nil) | + +For forward compatibility, these callback functions should have a `&rest' keyword at the end of argument list. + +For more complete example, see the demo function `ctbl:async-demo` at `samples/large-table.el`. + +### Sorting Async-Model + +The ctable doesn't provide default sorting function `ctbl:cmodel-sort-action` for the async-model data, because ctable can not receive whole rows of async-model. + +If sorting function is needed, the application program must implement it manually. + +* * * * * + +(C) 2012,2013 SAKURAI Masashi All rights reserved. +m.sakurai at kiwanami.net diff --git a/samples/direx-ctable.el b/samples/direx-ctable.el new file mode 100644 index 0000000..eb1e682 --- /dev/null +++ b/samples/direx-ctable.el @@ -0,0 +1,135 @@ +;;; direx-ctable.el --- direx table extension + +;; Copyright (C) 2013 SAKURAI Masashi + +;; Author: SAKURAI Masashi +;; Keywords: dired, ctable + +;; 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: + +;; collaboration between direx and ctable. + +;; ref: direx-el +;; https://github.com/m2ym/direx-el + +;;; Code: + +(require 'ctable) +(require 'direx) + +(defun dxt:collect-entries (direx-buf) + "[internal] " + (with-current-buffer direx-buf + (goto-char (point-min)) + (loop with data-list = nil + with goaheadp = t + for item = (direx:item-at-point) + while goaheadp do + (when (and item (direx:item-visible-p item)) + (push item data-list)) + (setq goaheadp (zerop (forward-line))) + finally return (nreverse data-list)))) + + +(defun dxt:item-render (item) + "[internal] " + (concat + (direx:item-render-indent-part item) + (direx:item-render-icon-part item) + (direx:item-render-name-part item))) + +(defun dxt:make-model-data-sort-prop (row item) + "[internal] " + (loop with head = (ctbl:format-left + 64 (file-name-directory (direx:file-full-name (direx:item-tree item)))) + for i in row + collect + (if (stringp i) + (propertize i 'dxt:sorter (message (format "%s%64s" head i))) i))) + +(defun dxt:make-model-data (buf) + "[internal] " + (loop for i in (dxt:collect-entries buf) + for itree = (direx:item-tree i) + for attr = (file-attributes (direx:file-full-name itree)) + collect + (dxt:make-model-data-sort-prop + (list + (dxt:item-render i) + (if (direx:item-leaf-p i) + (format "%d" (nth 7 attr)) " ") + (format-time-string "%Y/%m/%d %H:%M:%S" (nth 5 attr)) + i) i))) + +(defun dxt:make-model (buf) + "[internal] " + (make-ctbl:model + :column-model + (list + (make-ctbl:cmodel + :title "File" :min-width 10 :align 'left :sorter 'dxt:sort-item-lessp) + (make-ctbl:cmodel + :title "Size" :min-width 6 :align 'right :sorter 'dxt:sort-item-lessp) + (make-ctbl:cmodel + :title "Last Modified" :align 'left :sorter 'dxt:sort-item-lessp)) + :data + (dxt:make-model-data buf))) + +(defun dxt:sort-item-lessp (i j) + "[internal] Direx item comparator." + (let ((ii (get-text-property 0 'dxt:sorter i)) + (jj (get-text-property 0 'dxt:sorter j))) + (cond + ((string= ii jj) 0) + ((string< ii jj) -1) + (t 1)))) + +(defun dxt:node-action (direx-buf cp row) + "[internal] action handler" + (let ((item (nth 3 row))) + (cond + ((direx:item-leaf-p item) + (direx:find-item item)) + (t + (with-current-buffer direx-buf + (direx:item-toggle item)) + (ctbl:cp-set-model cp (dxt:make-model direx-buf)))))) + +(defun dxt:open (dirname) + (interactive "DDirex (directory): ") + (lexical-let* + ((dxbuf (direx:ensure-buffer-for-root + (direx:make-directory dirname))) + (cp + (ctbl:create-table-component-buffer + :width nil :height nil + :model + (dxt:make-model dxbuf)))) + (ctbl:cp-add-click-hook + cp (lambda () + (dxt:node-action + dxbuf cp (ctbl:cp-get-selected-data-row cp)))) + (switch-to-buffer (ctbl:cp-get-buffer cp)))) + +(defun dxt:open-here () + (interactive) + (dxt:open default-directory)) + +;; (progn (eval-current-buffer) (dxt:open-here)) + +(provide 'direx-ctable) +;;; direx-ctable.el ends here + diff --git a/samples/large-table.el b/samples/large-table.el new file mode 100644 index 0000000..9a9d556 --- /dev/null +++ b/samples/large-table.el @@ -0,0 +1,110 @@ +;;; An asynchronous data model sample for ctable.el + +(require 'ctable) +(require 'deferred) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; synchronous version + +(defun ctbl:sync-demo1 () + (interactive) + (ctbl:open-table-buffer-easy + (loop with lim = 4000 + for i from 0 upto lim + for d = (/ (random 1000) 1000.0) + collect + (list i d (exp (- (/ i 1.0 lim))) (exp (* (- (/ i 1.0 lim)) d)))))) + +;; (ctbl:sync-demo1) ; 5 seconds to display! + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; asynchronous version + +(defun ctbl:async-demo () + "Sample code for implementation for async data model table." + (interactive) + (let ((param (copy-ctbl:param ctbl:default-rendering-param))) + (setf (ctbl:param-fixed-header param) t) + (let* ((async-model ; define async-data-model + (make-ctbl:async-model + :request 'ctbl:async-demo-request + :cancel 'ctbl:async-demo-cancel + :reset 'ctbl:async-demo-reset + :init-num 40 :more-num 20)) + (cp + (ctbl:create-table-component-buffer + :model + (make-ctbl:model + :column-model + (list (make-ctbl:cmodel :title "row") + (make-ctbl:cmodel :title "delta") + (make-ctbl:cmodel :title "exp") + (make-ctbl:cmodel :title "exp-delta")) + :data async-model) ; here! + :param param))) + (ctbl:cp-add-click-hook + cp (lambda () (message "CTable : Click Hook [%S]" + (ctbl:cp-get-selected-data-row cp)))) + (pop-to-buffer (ctbl:cp-get-buffer cp))))) + +(defvar ctbl:async-demo-timer nil) + +(defun ctbl:async-demo-request (row-num len responsef errorf &rest) + (lexical-let + ((row-num row-num) (len len) + (responsef responsef) (errorf errorf)) + (setq ctbl:async-demo-timer + (deferred:$ + (deferred:wait 500) + (deferred:nextc it + (lambda (x) + (setq ctbl:async-demo-timer nil) + (funcall responsef + (if (< 500 row-num) nil + (loop with lim = 100 + for i from row-num below (+ row-num len) + for d = (/ (random 1000) 1000.0) + collect + (list i d (exp (- (/ i 1.0 lim))) + (exp (* (- (/ i 1.0 lim)) d)))))))))))) + +(defun ctbl:async-demo-reset (&rest) + (message "RESET async data!!")) + +(defun ctbl:async-demo-cancel (&rest) + (when ctbl:async-demo-timer + (deferred:cancel ctbl:async-demo-timer))) + +;; (progn (eval-current-buffer) (ctbl:async-demo)) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; async wrapper version + +(defun ctbl:sync-demo2 () + (interactive) + (let* ((async-model ; wrapping a huge data in async-data-model + (ctbl:async-model-wrapper + (loop with lim = 4000 + for i from 0 upto lim + for d = (/ (random 1000) 1000.0) + collect + (list i d (exp (- (/ i 1.0 lim))) (exp (* (- (/ i 1.0 lim)) d)))))) + (cp + (ctbl:create-table-component-buffer + :model + (make-ctbl:model + :column-model + (list (make-ctbl:cmodel :title "row") + (make-ctbl:cmodel :title "delta") + (make-ctbl:cmodel :title "exp") + (make-ctbl:cmodel :title "exp-delta")) + :data async-model)))) + (pop-to-buffer (ctbl:cp-get-buffer cp)))) + +;; (progn (eval-current-buffer) (ctbl:sync-demo2)) + + diff --git a/samples/simple.el b/samples/simple.el new file mode 100644 index 0000000..51fa9f0 --- /dev/null +++ b/samples/simple.el @@ -0,0 +1,166 @@ +(require 'ctable) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Simple samples + +;; popup a table + +(ctbl:popup-table-buffer-easy + '((1 2 3 4) + (5 6 7 8) + (9 10 11 12))) ; <- C-x C-e here to evaluate + + +;; popup a table with header + +(ctbl:popup-table-buffer-easy + '((1 2 3 4) + (5 6 7 8) + (9 10 11 12)) + '(aaa bbb ccc ddd)) ; <- C-x C-e here to evaluate + + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Complicated samples + +;; Model and View + +(let* ((column-model ; column model + (list (make-ctbl:cmodel + :title "A" :sorter 'ctbl:sort-number-lessp + :min-width 5 :align 'right) + (make-ctbl:cmodel + :title "Title" :align 'center + :sorter (lambda (a b) (ctbl:sort-number-lessp (length a) (length b)))) + (make-ctbl:cmodel + :title "Comment" :align 'left))) + (data + '((1 "Bon Tanaka" "8 Year Curry." 'a) + (2 "Bon Tanaka" "Nan-ban Curry." 'b) + (3 "Bon Tanaka" "Half Curry." 'c) + (4 "Bon Tanaka" "Katsu Curry." 'd) + (5 "Bon Tanaka" "Gyu-don." 'e) + (6 "CoCo Ichi" "Beaf Curry." 'f) + (7 "CoCo Ichi" "Poke Curry." 'g) + (8 "CoCo Ichi" "Yasai Curry." 'h) + (9 "Berkley" "Hamburger Curry." 'i) + (10 "Berkley" "Lunch set." 'j) + (11 "Berkley" "Coffee." k))) + (model ; data model + (make-ctbl:model + :column-model column-model :data data)) + (component ; ctable component + (ctbl:create-table-component-buffer + :model model))) + (pop-to-buffer (ctbl:cp-get-buffer component))) ; <- C-x C-e here to evaluate + + +;; Rendering parameters + +(let* ((param + (copy-ctbl:param ctbl:default-rendering-param)) + (column-model ; column model + (list (make-ctbl:cmodel + :title "A" :sorter 'ctbl:sort-number-lessp + :min-width 5 :align 'right) + (make-ctbl:cmodel + :title "Title" :align 'center + :sorter (lambda (a b) (ctbl:sort-number-lessp (length a) (length b)))) + (make-ctbl:cmodel + :title "Comment" :align 'left))) + (data + '((1 "Bon Tanaka" "8 Year Curry." 'a) + (2 "Bon Tanaka" "Nan-ban Curry." 'b) + (3 "Bon Tanaka" "Half Curry." 'c) + (4 "Bon Tanaka" "Katsu Curry." 'd) + (5 "Bon Tanaka" "Gyu-don." 'e) + (6 "CoCo Ichi" "Beaf Curry." 'f) + (7 "CoCo Ichi" "Poke Curry." 'g) + (8 "CoCo Ichi" "Yasai Curry." 'h) + (9 "Berkley" "Hamburger Curry." 'i) + (10 "Berkley" "Lunch set." 'j) + (11 "Berkley" "Coffee." k))) + (model ; data model + (make-ctbl:model + :column-model column-model :data data)) + component) + + (setf (ctbl:param-fixed-header param) t) ; set header parameters + (setf (ctbl:param-hline-colors param) ; horizontal line color + '((0 . "#00000") (1 . "#909090") (-1 . "#ff0000") (t . "#00ff00"))) + (setf (ctbl:param-draw-hlines param) ; horizontal line draw conditions + (lambda (model row-index) + (cond ((memq row-index '(0 1 -1)) t) + (t (= 0 (% (1- row-index) 5)))))) + (setf (ctbl:param-bg-colors param) ; cell background color + (lambda (model row-id col-id str) + (cond ((string-match "CoCo" str) "LightPink") + ((= 0 (% (1- row-index) 2)) "Darkseagreen1") + (t nil)))) + + (setq component ; building a ctable component + (ctbl:create-table-component-buffer + :model model :param param)) ; apply the parameter to component rendering + + (pop-to-buffer (ctbl:cp-get-buffer component))) ; <- C-x C-e here to evaluate + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Event handling + +(lexical-let* + ((column-model ; column model + (list (make-ctbl:cmodel + :title "A" :sorter 'ctbl:sort-number-lessp + :min-width 5 :align 'right) + (make-ctbl:cmodel + :title "Title" :align 'center + :sorter (lambda (a b) (ctbl:sort-number-lessp (length a) (length b)))) + (make-ctbl:cmodel + :title "Comment" :align 'left))) + (data + '((1 "Bon Tanaka" "8 Year Curry." 'a) + (2 "Bon Tanaka" "Nan-ban Curry." 'b) + (3 "Bon Tanaka" "Half Curry." 'c) + (4 "Bon Tanaka" "Katsu Curry." 'd) + (5 "Bon Tanaka" "Gyu-don." 'e) + (6 "CoCo Ichi" "Beaf Curry." 'f) + (7 "CoCo Ichi" "Poke Curry." 'g) + (8 "CoCo Ichi" "Yasai Curry." 'h) + (9 "Berkley" "Hamburger Curry." 'i) + (10 "Berkley" "Lunch set." 'j) + (11 "Berkley" "Coffee." k))) + (model ; data model + (make-ctbl:model + :column-model column-model :data data)) + component) + + (setq component ; building a ctable component + (ctbl:create-table-component-buffer + :model model)) + + ;; Click event handler + (ctbl:cp-add-click-hook + component (lambda () + (let ((row (ctbl:cp-get-selected-data-row component))) + (message "CTable : Click Hook [%S]" row) + ;; increment ID column + (when (= 0 (cdr (ctbl:cp-get-selected component))) + (message ">> %S" row) + (incf (car row))) + (ctbl:cp-update component)))) ; update table + + ;; Selection change event handler + (ctbl:cp-add-selection-change-hook + component (lambda () (message "CTable : Select Hook %S" + (ctbl:cp-get-selected component)))) + + ;; Update event handler + (ctbl:cp-add-update-hook + component (lambda () (message "CTable : Update Hook"))) + + (pop-to-buffer (ctbl:cp-get-buffer component))) ; <- C-x C-e here to evaluate diff --git a/test-ctable.el b/test-ctable.el new file mode 100644 index 0000000..d057fa8 --- /dev/null +++ b/test-ctable.el @@ -0,0 +1,249 @@ +;;; test-ctable.el --- tests for ctable + +;; Copyright (C) 2012 SAKURAI Masashi + +;; Author: +;; Keywords: test + +;; 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: + +;; + +;;; Code: + +(defvar ctbl:test-buffer-name "*ctbl:test*") + +(defun ctbl:test-get-buffer () + (cond + ((not (equal (buffer-name) ctbl:test-buffer-name)) + (pop-to-buffer (get-buffer-create ctbl:test-buffer-name)) + (erase-buffer)) + (t (insert "--------------------------------------------------\n"))) + (get-buffer ctbl:test-buffer-name)) + + + +;; test code + +(defun ctbl:test-adjust-widths () + "[internal] Test function for `ctbl:render-adjust-cell-width'." + (interactive) + (let ((cmodels + (list (make-ctbl:cmodel) + (make-ctbl:cmodel :min-width 5) + (make-ctbl:cmodel :max-width 5))) + (init-column-widths '(1 6 3)) ; total = 10 + (tests + '( ; (total-width . (result widths)) + (nil . (1 6 3)) + (13 . (2 7 4)) ; res:3 -> 1 + (21 . (6 10 5)) ; res:11 -> 3...2 + (8 . (1 5 2)) ; res:-2 -> 1 + (6 . (1 5 1)) ; res:-4 -> 1 + ))) + + (ctbl:test-get-buffer) + (loop for (total-width . expected-widths) in tests + for result = (ctbl:render-adjust-cell-width + cmodels (copy-sequence init-column-widths) total-width) + if (equal result expected-widths) + do (insert (format "OK : cols %S\n" expected-widths)) + else + do (insert (format "NG : Expected %S -> Result %S\n" expected-widths result))))) + +;; (ctbl:test-adjust-widths) + +(defun ctbl:test-sort () + "[internal] Test function for `ctbl:sort'." + (interactive) + (let ((cmodels + (list (make-ctbl:cmodel :sorter 'ctbl:sort-number-lessp) + (make-ctbl:cmodel :sorter 'ctbl:sort-string-lessp) + (make-ctbl:cmodel))) + (rows + '((1 "c" "E") + (2 "b" "D") + (3 "b" "B") + (4 "a" "C") + (5 "a" "A"))) + (tests '(( ( ) . (1 2 3 4 5)) + ( ( 1) . (1 2 3 4 5)) + ( (-1) . (5 4 3 2 1)) + ( ( 2) . (4 5 2 3 1)) + ( (-2) . (1 2 3 4 5)) + ( ( 3) . (5 3 4 2 1)) + ( (-3) . (1 2 4 3 5)) + ( ( 1 2) . (1 2 3 4 5)) + ( ( 2 1) . (4 5 2 3 1)) + ( (-2 1) . (1 2 3 4 5)) + ( (2 -1) . (5 4 3 2 1)) + ( ( 2 3) . (5 4 3 2 1)) + ( (2 -3) . (4 5 2 3 1))))) + (ctbl:test-get-buffer) + (loop for (keys . order) in tests + for sorted = (ctbl:sort (copy-sequence rows) cmodels keys) + for nums = (mapcar 'car sorted) + if (equal order nums) + do (insert (format "OK : Keys %S\n" keys sorted)) + else + do (insert (format "NG : Keys %S -> sorted %S\n" keys sorted))))) + +;; (ctbl:test-sort) + +(defun ctbl:test-modify-sort-key () + (interactive) + (let ((model (make-ctbl:model :data 'data :sort-state nil)) + (tests + '((0 . (1)) (0 . (-1)) (0 . (1)) + (1 . (2 1)) (1 . (-2 1)) (1 . (2 1)) + (2 . (3 2 1)) (0 . (1 3 2)) (0 . (-1 3 2)) (1 . (2 -1 3)) + (0 . (1 2 3))))) + (ctbl:test-get-buffer) + (loop for (col-index . order) in tests + for keys = (ctbl:model-modify-sort-key model col-index) + if (equal order keys) + do (insert (format "OK : Col %s | Keys %S\n" col-index keys)) + else + do (insert (format "NG : Col %s | Keys %S -> sorted %S\n" col-index order keys))))) + +;; (ctbl:test-modify-sort-key) + +(defun ctbl:test-render-join () + (lexical-let* + ((param (copy-ctbl:param ctbl:default-rendering-param)) + (model 'model) ; dummy + (src '("11" "22" "33" "44")) + (tests + (list + (cons "|11|22|33|44|" + (lambda () + (setf (ctbl:param-vline-colors param) "DarkGray") + (setf (ctbl:param-draw-vlines param) 'all) + (ctbl:render-join-columns (copy-sequence src) model param))) + (cons "|112233|44" + (lambda () + (setf (ctbl:param-vline-colors param) '((0 . "Red") (3 . "Blue"))) + (setf (ctbl:param-draw-vlines param) '(0 3)) + (ctbl:render-join-columns (copy-sequence src) model param))) + (cons "|11|223344|" + (lambda () + (setf (ctbl:param-vline-colors param) '((0 . "Red") (-1 . "Blue"))) + (setf (ctbl:param-draw-vlines param) '(0 1 -1)) + (ctbl:render-join-columns (copy-sequence src) model param))) + (cons "|1122|3344|" + (lambda () + (setf (ctbl:param-vline-colors param) + (lambda (model col-index) + (nth col-index '("Gray" "White" "Pink")))) + (setf (ctbl:param-draw-vlines param) + (lambda (model col-index) + (memq col-index '(0 -1 2)))) + (ctbl:render-join-columns (copy-sequence src) model param)))))) + (ctbl:test-get-buffer) + (loop for (exp . test) in tests + for res = (condition-case err (funcall test) (t err)) + if (equal res exp) + do (insert (format "OK %s\n" res)) + else + do (insert (format "NG %s -> %s\n" exp res))))) + +;; (ctbl:test-render-join) + +(defun ctbl:test-bg-colors () + (let* ((param (copy-ctbl:param ctbl:default-rendering-param)) + (model 'model) ; dummy + (tests + (list + (cons '((0 0 nil) (1 1 nil)) + nil) + (cons '((0 0 "black") (1 1 "white")) + '(((0 . 0) . "black") (t . "white"))) + (cons '((0 0 "blue") (1 1 "red")) + (lambda (m row-id col-id str) + (let ((pair (cons row-id col-id))) + (cond + ((equal '(0 . 0) pair) + "blue") + ((equal '(1 . 1) pair) + "red") + (t (error "BUG %S" pair)))))) + (cons '((0 0 nil) (1 0 "green") (2 0 nil) (3 0 "green")) + (lambda (m row-id col-id str) + (cond + ((= 0 (% row-id 2)) nil) + (t "green"))))))) + (ctbl:test-get-buffer) + (loop for (samples . test) in tests + for test-id from 1 do + (setf (ctbl:param-bg-colors param) test) + (loop for (row-id col-id exp) in samples + for enum-id from 1 + for res = (condition-case err + (ctbl:render-bg-color + "dummy" row-id col-id model param ) (t err)) + if (equal res exp) + do (insert (format "OK [%s-%s] %s\n" test-id enum-id res)) + else + do (insert (format "NG [%s-%s] %s -> %s | %S\n" test-id enum-id exp res )))))) + +;; (ctbl:test-bg-colors) + +(defun ctbl:test-make-hline () + (let* + ((param (copy-ctbl:param ctbl:default-rendering-param)) + (model 'model) ; dummy + (cols '(1 2 3 4)) + (tests + (list + (cons 0 "1-2--2---2----3\n") + (cons 1 "7-8--8---8----9\n") + (cons -1 "4-5--5---5----6\n")))) + (setf (ctbl:param-draw-vlines param) 'all + (ctbl:param-draw-hlines param) 'all + (ctbl:param-left-top-corner param) ?1 + (ctbl:param-top-junction param) ?2 + (ctbl:param-right-top-corner param) ?3 + (ctbl:param-left-bottom-corner param) ?4 + (ctbl:param-bottom-junction param) ?5 + (ctbl:param-right-bottom-corner param) ?6 + (ctbl:param-left-junction param) ?7 + (ctbl:param-cross-junction param) ?8 + (ctbl:param-right-junction param) ?9) + (ctbl:test-get-buffer) + (loop for (pos . exp) in tests + for res = (ctbl:render-make-hline cols model param pos) + if (equal res exp) + do (insert (format "OK %s" res)) + else + do (insert (format "NG %s -> %s" exp res))) + )) + +;; (ctbl:test-make-hline) + +(defun ctbl:test-all () + (interactive) + (ctbl:test-adjust-widths) + (ctbl:test-sort) + (ctbl:test-bg-colors) + (ctbl:test-modify-sort-key) + (ctbl:test-render-join) + (ctbl:test-make-hline) + ) + +;; (progn (eval-current-buffer) (ctbl:test-all)) + +(provide 'test-ctable) +;;; test-ctable.el ends here -- cgit v1.2.3 From e6e0be77f345877c05318e7e2dd573c563a068fd Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 28 Sep 2016 15:48:58 -0300 Subject: Import emacs-ctable_0.1.2-2.debian.tar.xz [dgit import tarball emacs-ctable 0.1.2-2 emacs-ctable_0.1.2-2.debian.tar.xz] --- changelog | 11 ++++ compat | 1 + control | 27 +++++++++ copyright | 28 +++++++++ docs | 2 + elpa | 1 + patches/fix-documantation.diff | 130 +++++++++++++++++++++++++++++++++++++++++ patches/series | 1 + rules | 11 ++++ source/format | 1 + watch | 4 ++ 11 files changed, 217 insertions(+) create mode 100644 changelog create mode 100644 compat create mode 100644 control create mode 100644 copyright create mode 100644 docs create mode 100644 elpa create mode 100644 patches/fix-documantation.diff create mode 100644 patches/series create mode 100755 rules create mode 100644 source/format create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..c65dab2 --- /dev/null +++ b/changelog @@ -0,0 +1,11 @@ +emacs-ctable (0.1.2-2) unstable; urgency=medium + + * Add author's email + + -- Lev Lamberov Wed, 28 Sep 2016 23:48:58 +0500 + +emacs-ctable (0.1.2-1) unstable; urgency=medium + + * Initial release (Closes: #837891) + + -- Lev Lamberov Thu, 15 Sep 2016 12:51:43 +0500 diff --git a/compat b/compat new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +10 diff --git a/control b/control new file mode 100644 index 0000000..f87a5a5 --- /dev/null +++ b/control @@ -0,0 +1,27 @@ +Source: emacs-ctable +Section: lisp +Priority: optional +Maintainer: Debian Emacs addons team +Uploaders: Lev Lamberov +Build-Depends: debhelper (>= 10), + dh-elpa +Standards-Version: 3.9.8 +Testsuite: autopkgtest-pkg-elpa +Homepage: https://github.com/kiwanami/emacs-ctable +Vcs-Browser: https://anonscm.debian.org/cgit/pkg-emacsen/pkg/emacs-ctable.git/ +Vcs-Git: https://anonscm.debian.org/git/pkg-emacsen/pkg/emacs-ctable.git + +Package: elpa-ctable +Architecture: all +Depends: ${elpa:Depends}, + ${misc:Depends}, + emacs +Recommends: emacs (>= 46.0) +Enhances: emacs, + emacs24 +Built-Using: ${misc:Built-Using} +Description: table component for Emacs Lisp + Table component for Emacs Lisp. Emacs Lisp programs can display a nice table + view from an abstract data model. Many Emacs programs have the code for + displaying table views, such as dired, list-process, buffer-list and so on. + This package provides functions and a table framework for the table views. diff --git a/copyright b/copyright new file mode 100644 index 0000000..c17407a --- /dev/null +++ b/copyright @@ -0,0 +1,28 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: emacs-ctable +Source: https://github.com/kiwanami/emacs-ctable + +Files: * +Copyright: (C) 2011, 2012, 2013, 2014 Masashi Sakurai +License: GPL-3+ + +Files: debian/* +Copyright: (C) 2016 Lev Lamberov +License: GPL-3+ + +License: GPL-3+ + 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 . + . + On Debian systems, the complete text of the GNU General + Public License version 3 can be found in `/usr/share/common-licenses/GPL-3' diff --git a/docs b/docs new file mode 100644 index 0000000..4f357a9 --- /dev/null +++ b/docs @@ -0,0 +1,2 @@ +*.md +img/*.png diff --git a/elpa b/elpa new file mode 100644 index 0000000..70490d7 --- /dev/null +++ b/elpa @@ -0,0 +1 @@ +ctable.el diff --git a/patches/fix-documantation.diff b/patches/fix-documantation.diff new file mode 100644 index 0000000..6b52176 --- /dev/null +++ b/patches/fix-documantation.diff @@ -0,0 +1,130 @@ +--- a/readme.md ++++ b/readme.md +@@ -19,26 +19,26 @@ and add the following code to your progr + Giving a list of the rows list to the function `ctbl:popup-table-buffer-easy', a simple table buffer is popped out. + + ```lisp +-(ctbl:popup-table-buffer-easy ++(ctbl:popup-table-buffer-easy + '((1 2 3 4) (5 6 7 8) (9 10 11 12))) + ``` + + Here is the result image. The header titles are generated automatically. + +-![sample-1-1](img/sample-1-1.png) ++![sample-1-1](/usr/share/doc/elpa-ctable/sample-1-1.png) + + + Giving two lists, the latter list is displayed at header titles. + + ```lisp +-(ctbl:popup-table-buffer-easy ++(ctbl:popup-table-buffer-easy + '((1 2 3 4) (5 6 7 8) (9 10 11 12)) + '(aaa bbb ccc ddd)) + ``` + + Here is the result image. + +-![sample-1-2](img/sample-1-2.png) ++![sample-1-2](/usr/share/doc/elpa-ctable/sample-1-2.png) + + ## Basic Use + +@@ -50,7 +50,7 @@ Second, one chooses builds the view comp + + Here is an illustration for the object relations in this basic case. + +-![Object relations](img/normal_use.png) ++![Object relations](/usr/share/doc/elpa-ctable/normal_use.png) + + Here is a sample code for the model and view. + +@@ -87,7 +87,7 @@ Here is a sample code for the model and + + Here is the result image. + +-![sample-2-1](img/sample-2-1.png) ++![sample-2-1](/usr/share/doc/elpa-ctable/sample-2-1.png) + + + The models have further options and functions to customize the display and behavior, such as column width, text alignment, sorting and so on. (See Model section) +@@ -98,7 +98,7 @@ The ctable framework provides some hooks + + The appearance of the table can be customized, such as foreground and background color, tabular lines. (See Display Parameter section) + +-![ctable components](img/objects.png) ++![ctable components](/usr/share/doc/elpa-ctable/objects.png) + + ## Sample Codes + +@@ -110,7 +110,7 @@ The appearance of the table can be custo + - directory tree and table list in collaboration with direx.el + - ref: https://github.com/m2ym/direx-el + +-![direx-ctable image](img/direx-ctable.png) ++![direx-ctable image](/usr/share/doc/elpa-ctable/direx-ctable.png) + + + # Advanced Topics +@@ -159,8 +159,8 @@ The ctable provides some hooks for the p + Here is a sample code for the click action: + + ```lisp +-(ctbl:cp-add-click-hook +- cp (lambda () (message "CTable : Click Hook [%S]" ++(ctbl:cp-add-click-hook ++ cp (lambda () (message "CTable : Click Hook [%S]" + (ctbl:cp-get-selected-data-row cp)))) + ``` + +@@ -263,7 +263,7 @@ Region destination example: + + Then, the tabular view will be embedded in the scratch buffer. You can navigate the ctable view in the buffer. Undoing for the some times, you can remove the ctable view. + +-![ctable in scratch buffer](img/region-scratch.png) ++![ctable in scratch buffer](/usr/share/doc/elpa-ctable/region-scratch.png) + + Because this destination never interacts anything out of the region and has its own key-binds as a text property, users can easily embed a tabular view in the other applications. + +@@ -351,11 +351,11 @@ Here is a sample code: + (loop with lim = 4000 + for i from 0 upto lim + for d = (/ (random 1000) 1000.0) +- collect ++ collect + (list i d (exp (- (/ i 1.0 lim))) (exp (* (- (/ i 1.0 lim)) d))))) + (async-model ; wrapping a large data in async-data-model + (ctbl:async-model-wrapper large-data)) +- (cp ; just build a component ++ (cp ; just build a component + (ctbl:create-table-component-buffer + :model + (make-ctbl:model +@@ -370,7 +370,7 @@ Here is a sample code: + + And here is the result image: + +-![async data wrapper](img/async-wrapper.png) ++![async data wrapper](/usr/share/doc/elpa-ctable/async-wrapper.png) + + + ### Case 2: Asynchronous Retrieving +@@ -387,7 +387,7 @@ Here is a minimum sample code: + (loop for i from row-num below (+ row-num len) + collect + (list i (* i i) (* i i i) (sqrt i))))) +- ++ + (ctbl:open-table-buffer-easy + (make-ctbl:async-model :request 'async-response) ; defining async-model + '("int" "square" "cube" "root")) +@@ -403,7 +403,7 @@ The `request` function should have 4 arg + + Here is the result image: + +-![defining async model:1](img/async-model-sample1.png) ++![defining async model:1](/usr/share/doc/elpa-ctable/async-model-sample1.png) + + #### ctbl:async-model struct + diff --git a/patches/series b/patches/series new file mode 100644 index 0000000..3522b6d --- /dev/null +++ b/patches/series @@ -0,0 +1 @@ +fix-documantation.diff diff --git a/rules b/rules new file mode 100755 index 0000000..875fa74 --- /dev/null +++ b/rules @@ -0,0 +1,11 @@ +#!/usr/bin/make -f + +%: + dh $@ --parallel --with elpa + +override_dh_auto_test: + emacs --batch -Q \ + -L . \ + -l test-ctable.el + +.PHONY: override_dh_auto_test diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/watch b/watch new file mode 100644 index 0000000..fb84ef2 --- /dev/null +++ b/watch @@ -0,0 +1,4 @@ +version=4 + opts="filenamemangle=s%(?:.*?)?v?(\d[\d.]*)\.tar\.gz%emacs-ctable-$1.tar.gz%" \ + https://github.com/kiwanami/emacs-ctable/tags \ + (?:.*?/)?v?(\d[\d.]*)\.tar\.gz debian uupdate -- cgit v1.2.3 From 588f3cb2b481c0360d6ae4dfbb318fc6656179fd Mon Sep 17 00:00:00 2001 From: Debian Emacs addons team Date: Wed, 28 Sep 2016 15:48:58 -0300 Subject: fix-documantation Gbp-Pq: Name fix-documantation.diff --- readme.md | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/readme.md b/readme.md index 27666af..f4b7a77 100644 --- a/readme.md +++ b/readme.md @@ -19,26 +19,26 @@ and add the following code to your program code. Giving a list of the rows list to the function `ctbl:popup-table-buffer-easy', a simple table buffer is popped out. ```lisp -(ctbl:popup-table-buffer-easy +(ctbl:popup-table-buffer-easy '((1 2 3 4) (5 6 7 8) (9 10 11 12))) ``` Here is the result image. The header titles are generated automatically. -![sample-1-1](img/sample-1-1.png) +![sample-1-1](/usr/share/doc/elpa-ctable/sample-1-1.png) Giving two lists, the latter list is displayed at header titles. ```lisp -(ctbl:popup-table-buffer-easy +(ctbl:popup-table-buffer-easy '((1 2 3 4) (5 6 7 8) (9 10 11 12)) '(aaa bbb ccc ddd)) ``` Here is the result image. -![sample-1-2](img/sample-1-2.png) +![sample-1-2](/usr/share/doc/elpa-ctable/sample-1-2.png) ## Basic Use @@ -50,7 +50,7 @@ Second, one chooses builds the view component with the models. Here is an illustration for the object relations in this basic case. -![Object relations](img/normal_use.png) +![Object relations](/usr/share/doc/elpa-ctable/normal_use.png) Here is a sample code for the model and view. @@ -87,7 +87,7 @@ Here is a sample code for the model and view. Here is the result image. -![sample-2-1](img/sample-2-1.png) +![sample-2-1](/usr/share/doc/elpa-ctable/sample-2-1.png) The models have further options and functions to customize the display and behavior, such as column width, text alignment, sorting and so on. (See Model section) @@ -98,7 +98,7 @@ The ctable framework provides some hooks to notify the usual events: click, sele The appearance of the table can be customized, such as foreground and background color, tabular lines. (See Display Parameter section) -![ctable components](img/objects.png) +![ctable components](/usr/share/doc/elpa-ctable/objects.png) ## Sample Codes @@ -110,7 +110,7 @@ The appearance of the table can be customized, such as foreground and background - directory tree and table list in collaboration with direx.el - ref: https://github.com/m2ym/direx-el -![direx-ctable image](img/direx-ctable.png) +![direx-ctable image](/usr/share/doc/elpa-ctable/direx-ctable.png) # Advanced Topics @@ -159,8 +159,8 @@ The ctable provides some hooks for the particular events: clicking, selection ch Here is a sample code for the click action: ```lisp -(ctbl:cp-add-click-hook - cp (lambda () (message "CTable : Click Hook [%S]" +(ctbl:cp-add-click-hook + cp (lambda () (message "CTable : Click Hook [%S]" (ctbl:cp-get-selected-data-row cp)))) ``` @@ -263,7 +263,7 @@ Region destination example: Then, the tabular view will be embedded in the scratch buffer. You can navigate the ctable view in the buffer. Undoing for the some times, you can remove the ctable view. -![ctable in scratch buffer](img/region-scratch.png) +![ctable in scratch buffer](/usr/share/doc/elpa-ctable/region-scratch.png) Because this destination never interacts anything out of the region and has its own key-binds as a text property, users can easily embed a tabular view in the other applications. @@ -351,11 +351,11 @@ Here is a sample code: (loop with lim = 4000 for i from 0 upto lim for d = (/ (random 1000) 1000.0) - collect + collect (list i d (exp (- (/ i 1.0 lim))) (exp (* (- (/ i 1.0 lim)) d))))) (async-model ; wrapping a large data in async-data-model (ctbl:async-model-wrapper large-data)) - (cp ; just build a component + (cp ; just build a component (ctbl:create-table-component-buffer :model (make-ctbl:model @@ -370,7 +370,7 @@ Here is a sample code: And here is the result image: -![async data wrapper](img/async-wrapper.png) +![async data wrapper](/usr/share/doc/elpa-ctable/async-wrapper.png) ### Case 2: Asynchronous Retrieving @@ -387,7 +387,7 @@ Here is a minimum sample code: (loop for i from row-num below (+ row-num len) collect (list i (* i i) (* i i i) (sqrt i))))) - + (ctbl:open-table-buffer-easy (make-ctbl:async-model :request 'async-response) ; defining async-model '("int" "square" "cube" "root")) @@ -403,7 +403,7 @@ The `request` function should have 4 arguments: Here is the result image: -![defining async model:1](img/async-model-sample1.png) +![defining async model:1](/usr/share/doc/elpa-ctable/async-model-sample1.png) #### ctbl:async-model struct -- cgit v1.2.3 From 6bd18c467e22f08063d98df6bf5cee361448f693 Mon Sep 17 00:00:00 2001 From: Debian Emacs addons team Date: Sat, 2 Jun 2018 20:18:01 -0300 Subject: fix-documantation Gbp-Pq: Name fix-documantation.diff --- readme.md | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/readme.md b/readme.md index 27666af..f4b7a77 100644 --- a/readme.md +++ b/readme.md @@ -19,26 +19,26 @@ and add the following code to your program code. Giving a list of the rows list to the function `ctbl:popup-table-buffer-easy', a simple table buffer is popped out. ```lisp -(ctbl:popup-table-buffer-easy +(ctbl:popup-table-buffer-easy '((1 2 3 4) (5 6 7 8) (9 10 11 12))) ``` Here is the result image. The header titles are generated automatically. -![sample-1-1](img/sample-1-1.png) +![sample-1-1](/usr/share/doc/elpa-ctable/sample-1-1.png) Giving two lists, the latter list is displayed at header titles. ```lisp -(ctbl:popup-table-buffer-easy +(ctbl:popup-table-buffer-easy '((1 2 3 4) (5 6 7 8) (9 10 11 12)) '(aaa bbb ccc ddd)) ``` Here is the result image. -![sample-1-2](img/sample-1-2.png) +![sample-1-2](/usr/share/doc/elpa-ctable/sample-1-2.png) ## Basic Use @@ -50,7 +50,7 @@ Second, one chooses builds the view component with the models. Here is an illustration for the object relations in this basic case. -![Object relations](img/normal_use.png) +![Object relations](/usr/share/doc/elpa-ctable/normal_use.png) Here is a sample code for the model and view. @@ -87,7 +87,7 @@ Here is a sample code for the model and view. Here is the result image. -![sample-2-1](img/sample-2-1.png) +![sample-2-1](/usr/share/doc/elpa-ctable/sample-2-1.png) The models have further options and functions to customize the display and behavior, such as column width, text alignment, sorting and so on. (See Model section) @@ -98,7 +98,7 @@ The ctable framework provides some hooks to notify the usual events: click, sele The appearance of the table can be customized, such as foreground and background color, tabular lines. (See Display Parameter section) -![ctable components](img/objects.png) +![ctable components](/usr/share/doc/elpa-ctable/objects.png) ## Sample Codes @@ -110,7 +110,7 @@ The appearance of the table can be customized, such as foreground and background - directory tree and table list in collaboration with direx.el - ref: https://github.com/m2ym/direx-el -![direx-ctable image](img/direx-ctable.png) +![direx-ctable image](/usr/share/doc/elpa-ctable/direx-ctable.png) # Advanced Topics @@ -159,8 +159,8 @@ The ctable provides some hooks for the particular events: clicking, selection ch Here is a sample code for the click action: ```lisp -(ctbl:cp-add-click-hook - cp (lambda () (message "CTable : Click Hook [%S]" +(ctbl:cp-add-click-hook + cp (lambda () (message "CTable : Click Hook [%S]" (ctbl:cp-get-selected-data-row cp)))) ``` @@ -263,7 +263,7 @@ Region destination example: Then, the tabular view will be embedded in the scratch buffer. You can navigate the ctable view in the buffer. Undoing for the some times, you can remove the ctable view. -![ctable in scratch buffer](img/region-scratch.png) +![ctable in scratch buffer](/usr/share/doc/elpa-ctable/region-scratch.png) Because this destination never interacts anything out of the region and has its own key-binds as a text property, users can easily embed a tabular view in the other applications. @@ -351,11 +351,11 @@ Here is a sample code: (loop with lim = 4000 for i from 0 upto lim for d = (/ (random 1000) 1000.0) - collect + collect (list i d (exp (- (/ i 1.0 lim))) (exp (* (- (/ i 1.0 lim)) d))))) (async-model ; wrapping a large data in async-data-model (ctbl:async-model-wrapper large-data)) - (cp ; just build a component + (cp ; just build a component (ctbl:create-table-component-buffer :model (make-ctbl:model @@ -370,7 +370,7 @@ Here is a sample code: And here is the result image: -![async data wrapper](img/async-wrapper.png) +![async data wrapper](/usr/share/doc/elpa-ctable/async-wrapper.png) ### Case 2: Asynchronous Retrieving @@ -387,7 +387,7 @@ Here is a minimum sample code: (loop for i from row-num below (+ row-num len) collect (list i (* i i) (* i i i) (sqrt i))))) - + (ctbl:open-table-buffer-easy (make-ctbl:async-model :request 'async-response) ; defining async-model '("int" "square" "cube" "root")) @@ -403,7 +403,7 @@ The `request` function should have 4 arguments: Here is the result image: -![defining async model:1](img/async-model-sample1.png) +![defining async model:1](/usr/share/doc/elpa-ctable/async-model-sample1.png) #### ctbl:async-model struct -- cgit v1.2.3