Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

704 lines (564 sloc) 17.851 kb
;;
;; Copyright (c) 2005-2012 uim Project http://code.google.com/p/uim/
;;
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or
;; without modification, are permitted provided that the
;; following conditions are met:
;;
;; 1. Redistributions of source code must retain the above
;; copyright notice, this list of conditions and the
;; following disclaimer.
;; 2. Redistributions in binary form must reproduce the above
;; copyright notice, this list of conditions and the
;; following disclaimer in the documentation and/or other
;; materials provided with the distribution.
;; 3. Neither the name of authors nor the names of its
;; contributors may be used to endorse or promote products
;; derived from this software without specific prior written
;; permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
;; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;
;;
;; Checks that the candidate list can be displayed inlinely on current window.
;;
(defun uim-check-candidate-space ()
;; don't show the candidate in mini-buffer
;; also thin window is not supported
(and (= (minibuffer-depth) 0)
(>= (window-width) uim-candidate-minimum-width)))
;;
;; Merge formatted text into current buffer
;;
(defun uim-merge-candidate ()
(let ((maxwidth (string-width (nth 1 (car uim-candidate-line-list))))
offset mark-base mark-cursor mark-limit)
;; format page label
(setq uim-candidate-page-label
(concat (make-string (- maxwidth
(- (string-width uim-candidate-page-label) 1))
(if uim-candidate-display-frame ?- 32))
uim-candidate-page-label))
;; make mark for chasing
(setq mark-cursor (point-marker))
(goto-char uim-candidate-start)
;; mark current-point
(setq mark-base (point-marker))
;; save font-lock face
(when uim-xemacs
(uim-overwrite-font-face uim-candidate-original-start
uim-candidate-original-end))
;; save original string
(setq uim-candidate-original-str
(buffer-substring uim-candidate-original-start
uim-candidate-original-end))
(save-excursion
(goto-char uim-candidate-original-end)
(setq mark-limit (point-marker)))
;; remove tabs/spaces
(uim-tab-pad-space uim-candidate-original-start
uim-candidate-original-end)
;; update uim-candidate-start
(let (base-ofs)
(setq base-ofs (- (marker-position mark-base) uim-candidate-start))
(setq uim-candidate-start (+ uim-candidate-start base-ofs)))
(set-marker mark-base nil)
(goto-char uim-candidate-start)
(save-excursion
(uim-vertical-motion 0)
(setq offset
(uim-string-width (buffer-substring (point) uim-candidate-start))))
;; if offset + maxwidth >= window-width then reduce offset
(if (>= (+ offset maxwidth 2) (window-width))
(setq offset (- (- (window-width) 1)
(+ maxwidth 2))))
(save-excursion
(if uim-show-candidate-upward
(uim-vertical-motion (- (+ (length uim-candidate-line-list) 1)))
(uim-vertical-motion uim-candidate-vofs))
(let ((rest t)
mergecount vhead linetmp padding overflow)
(save-excursion
(setq mergecount (uim-vertical-motion
(+ (length uim-candidate-line-list) 1))))
(while rest
(let (candidx candstr candsel)
(if uim-candidate-line-list
(progn
;; normal candidate line
(setq candidx (nth 0 (car uim-candidate-line-list)))
(setq candstr
(uim-format-string (nth 1 (car uim-candidate-line-list))
maxwidth))
(setq candsel (nth 2 (car uim-candidate-line-list)))
(setq candstr
(if uim-candidate-display-frame
(if candsel
(concat ">" candstr "<")
(concat "|" candstr "|"))
(if candsel
(concat "[" candstr "]")
(concat " " candstr " "))))
)
;; page label
(setq candidx 0)
(setq candstr
(if uim-candidate-display-frame
(concat "+" uim-candidate-page-label )
(concat " " uim-candidate-page-label )))
(setq candsel nil)
)
(if (> mergecount 0)
(progn
;; go virtual head of the next line
(if (not uim-show-candidate-upward)
(uim-vertical-motion 1))
(setq vhead (point))
(if (<= (save-excursion
(end-of-line)
(point))
(marker-position mark-limit))
;; make new line
(save-excursion
(end-of-line)
;; |ABCDEFGH\ + |___aaa__|
;; |IJKLMN |
;;
;; get region from vhead to physical end
;;
;; linetmp = ABCDEFGH
;;
(setq linetmp
(truncate-string-to-width (buffer-substring vhead (point))
(window-width)))
;; make padding by truncating linetmp to offset size
;; (add space as padding if shortage)
;; witdth of padding is equal to offset
;;
;; padding = ABC
;;
(setq padding
(truncate-string-to-width linetmp offset nil 32))
;; overflow = GH
;;
(let ((candwidth (+ maxwidth 2)))
(if (>= (uim-string-width linetmp) (+ offset candwidth))
(setq overflow
(truncate-string-to-width linetmp
(uim-string-width linetmp)
(+ offset candwidth) 32))
(setq overflow "")))
;; index string selected appendix
(save-excursion
(goto-char vhead)
(delete-region vhead (+ vhead (length linetmp)))
(when uim-xemacs
(insert " ")
(remove-text-properties (- (point) 1) (point)
'(face nil))
(goto-char (- (point) 1)))
(insert (concat padding
candstr
overflow))
(when uim-xemacs
(delete-char 1))
)
(uim-set-candidate-face candidx candsel
(+ vhead (length padding))
(length candstr))
;; update merge-end
(save-excursion
(end-of-line)
(setq uim-candidate-end
(if (> (marker-position mark-limit) (point))
(marker-position mark-limit)
(point))))
(setq mergecount (- mergecount 1))
)
)
(if uim-show-candidate-upward
(uim-vertical-motion 1))
)
;; append
(let (vhead)
(goto-char (point-max))
(setq vhead (+ (point) 1))
(insert (concat "\n"
(make-string offset 32)
candstr))
(uim-set-candidate-face candidx candsel
(+ vhead offset)
(length candstr))
(save-excursion
(end-of-line)
(setq uim-candidate-end (point)))
)))
(if uim-candidate-line-list
(setq uim-candidate-line-list
(cdr uim-candidate-line-list))
(setq rest nil))
)
(force-mode-line-update)
;; update cursor position
(goto-char (marker-position mark-cursor))
(setq uim-candidate-cursor (point))
;; move to end of preedit
(if uim-show-candidate-upward
(save-excursion
(end-of-line)
(setq uim-candidate-end (point))))
(set-marker mark-cursor nil)
))
))
(defun uim-echo-candidate (cand)
;; display candidate in minibuffer
(let* ((cands "")
(selstart 0)
(selend 0)
(page-current (format "%d" (caar cand)))
(page-total (format "%d" (cdar cand)))
(cand-height 0)
(displayed nil)
(echo-max-height 1)
(page-space (- (string-width page-total)
(string-width page-current)))
(page-label (concat (if (> page-space 0)
(make-string page-space 32))
page-current "/" page-total " "))
cands-tmp
(uim-candidate-in-echo-region t)
)
(setq cand (cdr cand))
(mapcar
'(lambda (x)
(let ((selected (nth 0 x))
(candlabel (nth 1 x))
(candstr (nth 2 x)))
(if selected
(setq selstart (length cands)))
(setq cands
(if selected
(concat cands "[" candlabel "." candstr "]")
(concat cands " " candlabel "." candstr " ")))
(if selected
(setq selend (length cands)))
)
) cand)
(setq cands-tmp (concat page-label cands))
(if (and uim-allow-resize-echo-region
uim-emacs
(>= emacs-major-version 21))
;; Emcas-21 or Emacs-22
(let (message-log-max)
(save-excursion
(set-buffer (get-buffer-create uim-el-candidates-buffer-name))
(erase-buffer)
(insert cands-tmp)
(setq cand-height (+ (uim-vertical-distance 1 (buffer-end 1)) 1))
(let ((current-minibuf (window-buffer (minibuffer-window))))
(set-window-buffer (minibuffer-window)
uim-el-candidates-buffer-name)
(set-buffer (window-buffer (minibuffer-window)))
;; estimate height of candidates in mini buffer
(setq cand-height (+ (uim-vertical-distance 1 (buffer-end 1)) 1))
(set-window-buffer (minibuffer-window) current-minibuf))
(message cands-tmp)
(if (= (setq echo-max-height (window-height (minibuffer-window)))
cand-height)
(setq displayed t)))))
(if (not displayed)
;; Emacs-20 or XEmacs or uim-allow-resize-echo-region is nil
;; or too small frame
(let* ((trimmed "")
(page-width (string-width page-label))
(page-cands-width (string-width cands-tmp))
(cands-width (string-width cands))
(candreg-width (- (- (* (window-width) echo-max-height) 1)
page-width)))
(cond ((>= candreg-width cands-width)
(setq trimmed cands-tmp))
((<= (window-width) page-width)
;; this part might not be reached
(setq trimmed (truncate-string-to-width page-label
(- (window-width) 1))))
((<= (window-width) (+ page-width 6))
(setq trimmed (concat page-label
(make-string
(- (window-width) page-width 1)
?.))))
((= selstart 0)
;; | 10/134 [1.xxxxx] 2.yyyyy 3.zzzzz ...|
(setq cands
(truncate-string-to-width cands
(if (> candreg-width 3)
(- candreg-width 3)
0)))
(setq trimmed
(concat page-label
cands
(make-string (- candreg-width
(string-width cands))
?.)))
)
((<= (string-width (substring cands selstart))
(- candreg-width 3)) ;; at least 1 dot
;; | 10/134 ...yyy [3.zzzzz]
(setq cands
(truncate-string-to-width cands
cands-width
(+ (- cands-width
candreg-width) 3)))
(setq trimmed
(concat page-label
(make-string (- candreg-width
(string-width cands))
?.)
cands)))
(t
;; | 10/134 ...[3.zzzzz] ---- ...|
(setq cands
(concat "..."
(truncate-string-to-width (substring cands selstart)
(if (> candreg-width 6)
(- candreg-width 6)
0))))
(setq trimmed
(concat page-label
cands
(make-string (- candreg-width
(string-width cands))
?.)))))
(let (message-log-max)
(message trimmed))))
)
)
;;
;; Make candidate list to be displayed
(defun uim-make-candlist (cand)
;; cand: (( <nil|t> "candlabel" "candstr" ) ... )
(let* ((i 1)
(truncwidth (min (- (window-width) 3)
(max (+ uim-max-candlabel uim-max-candstr 1)
(- (string-width uim-candidate-page-label) 1))))
(candlist '()))
(mapcar
'(lambda (x)
(let ((selected (nth 0 x))
(candlabel (nth 1 x))
(candstr (nth 2 x)))
(setq candlabel
(concat (make-string (- uim-max-candlabel
(string-width candlabel)) 32)
candlabel))
(setq candstr (concat candlabel "." candstr))
(catch 'truncate-loop
(let (candlabelpad)
(while t
(let* ((trunc (truncate-string-to-width candstr
truncwidth nil))
(width-truncated (string-width trunc))
)
(setq candlist
(append candlist
(list
(list i (concat trunc
(make-string (- truncwidth
width-truncated)
32))
selected))))
(if (= width-truncated (string-width candstr))
(throw 'truncate-loop t))
(if (not candlabelpad)
(setq candlabelpad
(make-string (+ (string-width candlabel) 1) 32)))
(setq candstr
(concat candlabelpad
(truncate-string-to-width candstr
(string-width candstr)
width-truncated)))
))))
)
(setq i (+ i 1))
) cand)
(setq uim-candidate-line-list candlist)
)
)
;;
;; Put overlay
;;
(defun uim-set-candidate-face (index selected begin length)
(let (face)
(cond
(selected
(setq face 'uim-candidate-selected-face))
((= index 0)
(setq face 'uim-candidate-nth-face))
((= (% index 2) 1)
(setq face 'uim-candidate-odd-face))
((= (% index 2) 0)
(setq face 'uim-candidate-even-face)))
(put-text-property begin (+ begin length) 'face face)
))
(defun uim-check-overlay (head tail)
(if (> head (point-min))
(setq head (- head 1)))
(if (< tail (point-max))
(setq tail (+ tail 1)))
(overlays-in head tail))
;;
;; Insert candidate string
;;
(defun uim-show-candidate (candidate)
;; separate appendix (for prime...)
(setq candidate
(cons (car candidate)
(mapcar
'(lambda (x)
(let ((selected (nth 0 x))
(candlabel (nth 1 x))
(candstr (nth 2 x))
eom)
;; separate appendix (for prime...)
(if (not uim-candidate-display-appendix)
(when (string-match "\t" candstr)
(setq candstr (substring candstr 0
(match-beginning 0))))
(while (setq eom (string-match "\t" candstr))
(setq candstr
(concat (substring candstr 0 eom)
" "
(substring candstr (+ eom 1))))))
(list selected candlabel candstr)
)
) (cdr candidate))))
(setq uim-max-candlabel
(eval (cons 'max
(mapcar '(lambda (x) (string-width (nth 1 x)))
(cdr candidate)))))
;; get max width
(setq uim-max-candstr
(eval (cons 'max
(mapcar '(lambda (x) (string-width (nth 2 x)))
(cdr candidate)))))
(setq uim-candidate-page-label
(format "%d/%d" (caar candidate) (cdar candidate)))
(setq uim-candidate-original-start nil)
(setq uim-candidate-original-end nil)
(let ((display-inline uim-candidate-display-inline)
(upward-end-line nil))
(if (>= (max (+ uim-max-candlabel 6)
(+ (string-width uim-candidate-page-label) 2))
(window-width))
(setq display-inline nil))
(if (/= (window-hscroll) 0)
(setq display-inline nil))
(if display-inline
(uim-make-candlist (cdr candidate)))
(if display-inline
(save-excursion
(goto-char uim-candidate-start)
(let ((winofs (save-excursion
(goto-char uim-candidate-cursor)
(uim-get-window-offset)))
(candlines (+ 1 (length uim-candidate-line-list)))
ol-down dhead dtail uhead utail)
(if (and (not (setq ol-down (uim-check-overlay
(save-excursion
(beginning-of-line)
(setq dhead (point)))
(save-excursion
(uim-vertical-motion
(+ uim-candidate-vofs
candlines))
(end-of-line)
(setq dtail (point))))))
;;
(save-excursion
(goto-char uim-candidate-cursor)
(>= (- (- (window-height) 1) (+ winofs 1))
(+ candlines 1))))
(progn
(setq uim-show-candidate-upward nil)
(setq uim-candidate-original-start dhead)
(setq uim-candidate-original-end dtail))
(if (and (>= winofs candlines)
(not (uim-check-overlay
(save-excursion
(uim-vertical-motion (- candlines))
(beginning-of-line)
(setq uhead (point)))
(save-excursion
(end-of-line)
(setq utail (point)))))
)
(progn
(save-excursion
(setq upward-end-line (uim-get-window-offset)))
(setq uim-show-candidate-upward t)
(setq uim-candidate-original-start uhead)
(setq uim-candidate-original-end utail))
;; Scroll buffer to show all candidates
(if (and (not ol-down)
(>= (- (window-height) 1) (+ candlines 1)))
(progn
(setq uim-show-candidate-upward nil)
(if (not uim-window-force-scrolled-original)
(setq uim-window-force-scrolled-original
(window-start)))
(setq uim-window-force-scrolled t)
(setq uim-candidate-original-start dhead)
(setq uim-candidate-original-end dtail)
(save-excursion
(goto-char uim-candidate-cursor)
(recenter (- (- (- (window-height) 1) candlines) 1))))
;; disable inline display
(setq display-inline nil)
))))))
(if display-inline
;; inline candidate display mode
(let ((inhibit-read-only t))
(uim-merge-candidate)
(if uim-show-candidate-upward
(save-excursion
(recenter upward-end-line)))
)
;; display in echo region
(uim-echo-candidate candidate)
)
)
)
;;
;; Remove candidate
;;
(defun uim-remove-candidate ()
(if (and uim-candidate-display-inline
uim-candidate-original-start)
(let ((inhibit-read-only t))
;; delete region which includes candidate
(delete-region uim-candidate-original-start
uim-candidate-end)
;; restore original region
(save-excursion
(goto-char uim-candidate-original-start)
(insert uim-candidate-original-str))
)
;; clear minibuffer
(let (message-log-max)
(message nil))
)
)
(provide 'uim-candidate)
Jump to Line
Something went wrong with that request. Please try again.