;; -*- mode: emacs-lisp; coding: hebrew-iso-8bit-unix; -*- ;; kyc.el --- function related to kyocera printers formatting ;; prepare prints & LFD / RVRD graphic conversion ;; Copyright (C) 1992-2000 Ehud karni ;; This file is NOT part of GNU Emacs, distribution conditions below. ;; ;; EHUD KARNI ינרק דוהא ;; Ben Gurion st' 14 ןוירוג ןב 'חר ;; Kfar - Sava 44 257 אבס - רפכ ;; =================================== ;; 972-(0)9-7659599 ;; =================================== ;; RCS: $Id: kyc.el,v 1.102 2001/11/26 11:47:23 ehud Exp $ ;; ;; $Log: kyc.el,v $ ;; Revision 1.102 2001/11/26 11:47:23 ehud ;; Change encoding to hebrew-iso-8bit-unix ;; ;; Revision 1.101 2000/03/05 13:42:33 ehud ;; Comment headers changes (NOT GNU) + Very minor fixes. ;; ;; Revision 1.100 1998/11/11 13:17:27 ehud ;; Initial RCS (and last for 19.34) version ;; 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 2 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, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (defun man-page-prepare-for-kyc () (interactive) (let* (overwrite-mode ;; set to insert because of bug in backward-delete-char buffer-read-only ;; ignore read only stri strb stru ;; input, bold & underline strings bolp tp) ;; begining of line position (untabify-all) ;; ensure no tabs ! (goto-char (point-min)) (while (not (eobp)) ;; do on all lines (setq bolp (point)) (insert " ") (forward-line 1) ;;start of next line or EOF (setq stri (buffer-substring bolp (1- (point)))) (setq bolp (length stri)) (setq strb (make-string bolp ? )) (setq stru (make-string bolp ? )) (while (> bolp 1) (setq bolp (1- bolp)) (setq tp (get-text-property bolp 'face stri)) (cond ((equal tp 'bold) ;; bold (erase underline) (aset strb bolp (aref stri bolp))) ((equal tp 'underline) ;; under (erase bold) (aset stru bolp ?_)) ((equal tp 'bold-under) ;; do nothing (aset strb bolp (aref stri bolp)) (aset stru bolp ?_)))) (aset strb 0 ?E) ;; bold CC (aset stru 0 ?+) ;; under CC (or (string-match "^E[ ]*$" strb) (insert strb "\n")) ;; add "bolding" line (or (string-match "^+[ ]*$" stru) (insert stru "\n"))) ;; add "underline" line (goto-char (point-min)) (strip-blanks-right))) (defun swhelp-prepare-for-kyc () (interactive) (let* (overwrite-mode ;; set to insert because of bug in backward-delete-char buffer-read-only ;; ignore read only (swhelp-font-z (face-id 'swhelp-font-00)) stri strb stru strr ;; input, bold & underline strings bolp tp) ;; begining of line position (untabify-all) ;; ensure no tabs ! (goto-char (point-min)) (while (not (eobp)) ;; do on all lines (setq bolp (point)) (insert " ") (forward-line 1) ;;start of next line or EOF (setq stri (buffer-substring bolp (1- (point)))) (setq bolp (length stri)) (setq strb (make-string bolp ? )) (setq strr (make-string bolp ? )) (setq stru (make-string bolp ? )) (while (> bolp 1) (setq bolp (1- bolp)) (and (setq tp (get-text-property bolp 'face stri)) (facep tp) (setq tp (- (face-id tp) swhelp-font-z)) (>= tp -1) ;; 1st font = -1 (invis) (< tp 32) ;; last swhelp font = 32 (progn (if (> (logand tp 10) 0) ;; highlight (bold) - 1, standout=8 (aset strb bolp (aref stri bolp))) (if (> (logand tp 24) 0) ;; reversed - 4, standout=8 (aset strr bolp 157)) ;; works on KYOCERA only (if (> (logand tp 17) 0) ;; underline - 16, standout=8 (aset stru bolp ?_)) ))) (aset strb 0 ?E) ;; bold CC (aset stru 0 ?+) ;; under CC (aset strr 0 ?+) ;; under CC (or (string-match "^E[ ]*$" strb) (insert strb "\n")) ;; add "bolding" line (or (string-match "^+[ ]*$" strr) (insert strr "\n")) ;; add "reversed" line (or (string-match "^+[ ]*$" stru) (insert stru "\n"))) ;; add "underline" line (goto-char (point-min)) (strip-blanks-right))) ;;======================================================================;; (defun kyc-add-char (ch new) "Convert from LDFC or RVRD format to 16 bits value. Current 16 bit value is CH, the input (in the LDFC/RVRD format) is NEW" (interactive) (cond ((= new 47) ;; / = 127 (setq ch (+ (ash ch 6) 63))) ((< new 48) ) ;; < 48 is wrong do nothing ((> new 126) ) ;; > 126 is wrong do nothing ((> new 63) ;; > 63 is 1st or 2nd (setq ch (+ (ash ch 6) new -64))) (t ;; 48-63 (setq ch (+ (ash ch 4) new 131024))))) (defun kyc-add-kvkv () "Replace all 8..8... & ...8..8 by 8..8..8" (interactive) (replace-string-whole-buffer "8..8..." "8..8..8") (replace-string-whole-buffer "...8..8" "8..8..8")) (defun kyc-break-into-size (PNTS) "Break LDF convert to g_char into lines containing PNTS points each. PNTS is convert to next whole multyple of 16." (interactive) (setq PNTS (ash (ash (+ PNTS 15) -4) 4)) ;next multiple of 16 (beginning-of-line) (let ((pos (point)) len) (end-of-line) (setq len (- (point) pos PNTS)) (goto-char pos) (while (> len 0) (setq len (- len PNTS)) (goto-col (1+ PNTS) t) (insert "\n")))) (defun kyc-g-chars-all-lines-to-LDF () "Convert all lines (in g_chars - 8 or .) to LDF format" (interactive) (while (not (eobp)) (kyc-g-chars-line-to-RVRD-LDF t) (forward-line 1))) (defun kyc-g-chars-all-lines-to-RVRD () "Convert all lines (in g_chars - 8 or .) to RVRD format" (interactive) (while (not (eobp)) (kyc-g-chars-line-to-RVRD-LDF nil) (forward-line 1))) (defun kyc-g-chars-line-to-RVRD-LDF (&optional LDF) "Convert a lines in g_chars (`8' for 1 bit, `.' for 0) to RVRD/LDF format if argument LDF is true convert to LDF format (omit the counter & terminating ;)" (interactive) (beginning-of-line) (let ((pos (point)) istr len) (end-of-line) (setq len (point)) (setq istr (buffer-substring pos len)) (setq len (- len pos)) (goto-char pos) (delete-char len) (if (> len 1) (kyc-g-chars-to-RVRD-LDF-str istr LDF)))) (defun kyc-g-chars-to-RVRD-LDF-str (STRING &optional LDF) "Convert STRING in g_chars (`8' for 1 bit, `.' for 0) to RVRD or LDF format if second argument LDF is true convert to LDF format (omit the counter)" (interactive) (let ((ix 0) (bt 0) (ch 0) (pnt16 (make-string 16 ?.)) (len (length STRING))) (setq STRING (concat STRING pnt16)) (setq len (ash (ash (+ len 15) -4) 4)) ;next multiple of 16 (if (not LDF) ;shorten & put counter (progn ;only in RVRD (while (string-equal (substring STRING (- len 16) len) pnt16) (setq len (- len 16))) (insert (format "%d;" (ash (+ len 7) -3))))) (while (< ix len) (setq ch 0) (setq bt (+ 16 bt)) (while (< ix bt) (setq ch (+ (ash ch 1) (if (/= (aref STRING ix) ?.) 1 0))) (setq ix (1+ ix))) (kyc-put-16-min ch))) (if (not LDF) ;ADD ; (insert ";"))) ;only in RVRD (defun kyc-put-g-chras (ch) "Convert 16 bit value - CH to 16 chars `8' for 1 bit, `.' for 0" (interactive) (let ((ich 16)) (while (> ich 0) (insert (if (/= (logand ch 32768) 0) ?8 ?.)) (setq ch (ash ch 1)) (setq ich (1- ich)))) t) ;; this function is not used (not needed) ;; (defun kyc-put-16-full (ch) ;; "Convert 16 bit value - CH to LDFC or RVRD format - full 3 output chars" ;; (interactive) ;; (let (ich) ;; (setq ich (+ (logand (ash ch -10) 63) 64)) ;; (insert (if (= ich 127) ;; ?/ ich)) ;; (setq ich (+ (logand (ash ch -4) 63) 64)) ;; (insert (if (= ich 127) ;; ?/ ich)) ;; (insert (+ (logand ch 15) 48)))) (defun kyc-put-16-min (ch) "Convert 16 bit value - CH to LDFC or RVRD format (minimum) 1-3 output chars" (interactive) (let ((ich1 (logand (ash ch -10) 63)) (ich2 (logand (ash ch -4) 63))) (if (> ich1 0) (insert (if (= ich1 63) ?/ (+ ich1 64)) (if (= ich2 63) ?/ (+ ich2 64))) (if (> ich2 0) (insert (if (= ich2 63) ?/ (+ ich2 64))))) (insert (+ (logand ch 15) 48)))) (defun kyc-LDFC-to-g-break () "convert LDFC data line to graphic block" (interactive) (let (pnts bp ep) (beginning-of-line) (and (setq bp (search-forward "," nil t 3)) (setq ep (search-forward "," nil t 1)) (setq pnts (string-to-number (buffer-substring bp ep))) (progn (forward-line 1) (kyc-RVRD-line-to-g-char) (kyc-break-into-size pnts))))) (defun kyc-LDFC-to-g-break-all () "convert all LDFC data lines to graphic block" (interactive) (while (search-forward "LDFC" nil t) (kyc-LDFC-to-g-break))) (defun kyc-RVRD-all-lines-to-g-char () "Convert all lines (RVRD/LDF format) to g_chars (`8' for 1 bit, `.' for 0)" (interactive) (while (not (eobp)) (kyc-RVRD-line-to-g-char) (forward-line 1))) (defun kyc-RVRD-line-to-g-char () "Convert current line (RVRD/LDF format) to g_chars (`8' for 1 bit, `.' for 0)" (interactive) (beginning-of-line) (let ((pos (point)) istr len) (end-of-line) (setq len (point)) (setq istr (buffer-substring pos len)) (setq len (- len pos)) (goto-char pos) (delete-char len) (if (string-match "^[0-9]+\;" istr) (setq istr (substring istr (match-end 0)))) (kyc-RVRD-str-to-g-chars istr))) (defun kyc-RVRD-str-to-g-chars (STRING) "Convert STRING in RVRD/LDF format to g_chars (`8' for 1 bit, `.' for 0)" (interactive) (let ((ix 0) (ch 0) len) (setq len (length STRING)) (if (= (aref STRING (1- len)) ?\;) (setq len (1- len))) (while (< ix len) (setq ch (kyc-add-char ch (aref STRING ix))) (setq ix (1+ ix)) (and (> ch 65536) (kyc-put-g-chras ch) (setq ch 0))))) ;;(global-set-key [f12] 'kyc-add-kvkv) ;;----------------------------- last line of kyc.el -------------------------